'コンソール
#console
Declare Function SetConsoleTextAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttributes As Word) As Long
Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (hConsoleOutput As HANDLE, lpConsoleScreenBufferInfo As *CONSOLE_SCREEN_BUFFER_INFO) As Long
Type COORD
X As Integer
Y As Integer
End Type
Type SMALL_RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Type CONSOLE_SCREEN_BUFFER_INFO
dwSize As COORD
dwCursorPosition As COORD
wAttributes As Word
srWindow As SMALL_RECT
dwMaximumWindowSize As COORD
End Type
Class ABC_CONSOLE
Private
stdin As HANDLE
stdout As HANDLE
stderr As HANDLE
csbi As CONSOLE_SCREEN_BUFFER_INFO
r As Long
w As Long
Public
Sub ABC_CONSOLE()
stdin = GetStdHandle(STD_INPUT_HANDLE)
stdout = GetStdHandle(STD_OUTPUT_HANDLE)
stderr = GetStdHandle(STD_ERROR_HANDLE)
GetConsoleScreenBufferInfo(stdout, VarPtr(csbi))
End Sub
Sub ~ABC_CONSOLE()
SetConsoleTextAttribute(stdout, csbi.wAttributes)
End Sub
Sub Color(attr As Word)
SetConsoleTextAttribute(stdout, attr)
End Sub
Function Gets(buf As *Byte, length As Long) As Long
ReadFile(stdin, buf, length, VarPtr(r), ByVal 0)
Gets = r
End Function
Function Puts(buf As *Byte, length As Long) As Long
WriteFile(stdout, buf, length, VarPtr(w), ByVal 0)
Puts = w
End Function
Function Getc() As Long
ReadFile(stdin, VarPtr(Getc), 1, VarPtr(r), ByVal 0)
If r = 0 Then Getc = -1
End Function
Function Putc(c As Long) As Long
WriteFile(stdout, VarPtr(c), 1, VarPtr(w), ByVal 0)
Putc = c
End Function
End Class
Dim ac As ABC_CONSOLE
Dim c As Long
c = ac.Getc()
While c <> -1
ac.Putc(c)
c = ac.Getc()
Wend
