Index: /trunk/ab5.0/ablib/src/Classes/System/Console.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/System/Console.ab (revision 621) +++ /trunk/ab5.0/ablib/src/Classes/System/Console.ab (revision 622) @@ -2,4 +2,29 @@ Namespace System + +Enum ConsoleColor + Black = 0 + DarkGray = FOREGROUND_INTENSITY + Gray = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE + White = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY + + DarkRed = FOREGROUND_RED + Red = FOREGROUND_RED Or FOREGROUND_INTENSITY + + DarkYellow = FOREGROUND_RED Or FOREGROUND_GREEN + Yellow = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY + + DarkGreen = FOREGROUND_GREEN + Green = FOREGROUND_GREEN Or FOREGROUND_INTENSITY + + DarkCyan = FOREGROUND_GREEN Or FOREGROUND_BLUE + Cyan = FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY + + DarkBlue = FOREGROUND_BLUE + Blue = FOREGROUND_BLUE Or FOREGROUND_INTENSITY + + DarkMagenta = FOREGROUND_RED Or FOREGROUND_BLUE + Magenta = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY +End Enum /* @@ -11,4 +36,231 @@ Public /* + @brief コンソールの背景色を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub BackgroundColor ( value As ConsoleColor ) + If ActiveBasic.IsNothing(Console.out) Then + Exit Sub + Else + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + csbi.wAttributes And = &HFF0F'背景色だけ変更できるようにマスク処理 + ret = SetConsoleTextAttribute(h,csbi.wAttributes Or (This.ConsoleColorToTextAttribute(value)<<4) As Word/* foreをbackへ変換 */) + If ret = 0 Then Throw New IO.IOException() + End If + End If + End Sub + Static Function BackgroundColor() As ConsoleColor + If ActiveBasic.IsNothing(Console.out) Then + Return ConsoleColor.Gray + Else + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Return ConsoleColor.Gray + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + Dim attributes = csbi.wAttributes And &H00F0'背景色だけ取り出せるようにマスク処理 + Return This.TextAttributeToConsoleColor(attributes>>4/* backをforeへ変換 */) + End If + End If + End Function + + + /* + @brief バッファ領域の高さを取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub BufferHeight ( value As Long ) + Dim width As Long, height As Long + This.GetBufferSize(width,height) + Console.SetBufferSize(width,value) + End Sub + Static Function BufferHeight () As Long + Dim width As Long, height As Long + This.GetBufferSize(width,height) + Return height + End Function + + /* + @brief バッファ領域の幅を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub BufferWidth ( value As Long ) + Dim width As Long, height As Long + This.GetBufferSize(width,height) + Console.SetBufferSize(value,height) + End Sub + Static Function BufferWidth () As Long + Dim width As Long, height As Long + This.GetBufferSize(width,height) + Return height + End Function + + /* + @brief カーソルの列位置を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub CursorLeft ( value As Long ) + Dim left As Long, top As Long + This.GetCursorPosition(left,top) + Console.SetCursorPosition(value,top) + End Sub + Static Function CursorLeft () As Long + Dim left As Long, top As Long + This.GetCursorPosition(left,top) + Return left + End Function + + /* + @brief 文字セル内のカーソルの高さを取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub CursorSize ( value As Long ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim cci As CONSOLE_CURSOR_INFO + Dim ret = GetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + cci.dwSize = value As DWord + ret = SetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + End If + End Sub + Static Function CursorSize () As Long + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Return -1 As Long + Else + Dim cci As CONSOLE_CURSOR_INFO + Dim ret = GetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + Return cci.dwSize As Long + End If + End Function + + /* + @brief カーソルの行位置を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub CursorTop ( value As Long ) + Dim left As Long, top As Long + This.GetCursorPosition(left,top) + Console.SetCursorPosition(left,value) + End Sub + Static Function CursorTop () As Long + Dim left As Long, top As Long + This.GetCursorPosition(left,top) + Return top + End Function + + /* + @brief カーソルを表示するかどうかを示す値を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub CursorVisible ( visible As Boolean ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim cci As CONSOLE_CURSOR_INFO + Dim ret = GetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + cci.bVisible = visible As BOOL + ret = SetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + End If + End Sub + Static Function CursorVisible () As Boolean + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Return False + Else + Dim cci As CONSOLE_CURSOR_INFO + Dim ret = GetConsoleCursorInfo(h,cci) + If ret = 0 Then Throw New IO.IOException() + Return cci.bVisible As Boolean + End If + End Function + + /* + @brief コンソールの前景色を取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub ForegroundColor ( value As ConsoleColor ) + If ActiveBasic.IsNothing(Console.out) Then + Exit Sub + Else + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + csbi.wAttributes And = &HFFF0'前景色だけ変更できるようにマスク処理 + ret = SetConsoleTextAttribute(h,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value)) + If ret = 0 Then Throw New IO.IOException() + End If + End If + End Sub + Static Function ForegroundColor() As ConsoleColor + If ActiveBasic.IsNothing(Console.out) Then + Return ConsoleColor.Gray + Else + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Return ConsoleColor.Gray + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + Dim attributes = csbi.wAttributes And &H000F'前景色だけ取り出せるようにマスク処理 + Return This.TextAttributeToConsoleColor(attributes) + End If + End If + End Function + + /* + @brief コンソールのタイトルを取得または設定する + @date 2008/09/02 + @auther NoWest + */ + Static Sub Title( title As String ) + Dim h = This.GetStdOutputHandle() + If h=NULL Then + Exit Sub + Else + SetConsoleTitle(StrPtr(title)) + End If + End Sub + Static Function Title() As String + Dim sb = New Text.StringBuilder(24500*SizeOf(Char)) + Dim h = This.GetStdOutputHandle() + If h=NULL Then + Return "" + Else + GetConsoleTitle(sb.__Chars(),sb.Length()) + End If + End Function + + + /* @brief 標準エラー出力を設定する @date 2008/08/21 @@ -211,4 +463,65 @@ Read = in.Read() End Function + + /* + @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア + @date 2008/09/02 + @auther NoWest + */ + Static Sub Clear() + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + Dim length = csbi.dwSize.X * csbi.dwSize.Y + Dim written As DWord + Dim s = New String(" ") + ret = FillConsoleOutputCharacter(h,s[0],length,0,written) + If ret = 0 Then Throw New IO.IOException() + ret = FillConsoleOutputAttribute(h,csbi.wAttributes,length,0,written) + If ret = 0 Then Throw New IO.IOException() + ret = SetConsoleCursorPosition(h,0) + If ret = 0 Then Throw New IO.IOException() + End If + End Sub + + /* + @brief バッファ領域の高さと幅を指定された値に設定 + @date 2008/09/02 + @auther NoWest + */ + Static Sub SetBufferSize ( width As Long, height As Long ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim size As COORD + size.X = width As Integer + size.Y = height As Integer + Dim ret = SetConsoleScreenBufferSize(h,COORDtoDWORD(size)) + If ret = 0 Then Throw New IO.IOException() + End If + End Sub + + /* + @brief カーソルの位置を設定 + @date 2008/09/02 + @auther NoWest + */ + Static Sub SetCursorPosition ( left As Long, top As Long ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim pos As COORD + pos.X = left As Integer + pos.Y = top As Integer + Dim ret = SetConsoleCursorPosition(h,COORDtoDWORD(pos)) + If ret = 0 Then Throw New IO.IOException() + End If + End Sub Private @@ -228,4 +541,80 @@ End Function + Function GetStdOutputHandle() As HANDLE + Dim sw = Console.out As IO.StreamWriter + Dim fs = sw.BaseStream() As IO.FileStream + Return fs.Handle() + End Function + + Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word + Dim ret = value As DWord + Return ret As Word + End Function + + Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor + Select Case value + Case 0 + Return ConsoleColor.Black + Case FOREGROUND_INTENSITY + Return ConsoleColor.DarkGray + Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE + Return ConsoleColor.Gray + Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY + Return ConsoleColor.White + Case FOREGROUND_RED + Return ConsoleColor.DarkRed + Case FOREGROUND_RED Or FOREGROUND_INTENSITY + Return ConsoleColor.Red + Case FOREGROUND_RED Or FOREGROUND_GREEN + Return ConsoleColor.DarkYellow + Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY + Return ConsoleColor.Yellow + Case FOREGROUND_GREEN + Return ConsoleColor.DarkGreen + Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY + Return ConsoleColor.Green + Case FOREGROUND_GREEN Or FOREGROUND_BLUE + Return ConsoleColor.DarkCyan + Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY + Return ConsoleColor.Cyan + Case FOREGROUND_BLUE + Return ConsoleColor.DarkBlue + Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY + Return ConsoleColor.Blue + Case FOREGROUND_RED Or FOREGROUND_BLUE + Return ConsoleColor.DarkMagenta + Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY + Return ConsoleColor.Magenta + Case Else + Return ConsoleColor.Gray + End Select + End Function + + Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + left = csbi.dwCursorPosition.X + top = csbi.dwCursorPosition.Y + End If + End Sub + + Sub GetBufferSize ( ByRef width As Long, ByRef height As Long ) + Dim h = This.GetStdOutputHandle() + If h = NULL Then + Exit Sub + Else + Dim csbi As CONSOLE_SCREEN_BUFFER_INFO + Dim ret = GetConsoleScreenBufferInfo(h,csbi) + If ret = 0 Then Throw New IO.IOException() + width = csbi.dwSize.X + height = csbi.dwSize.Y + End If + End Sub + Static in = Nothing As IO.TextReader Static out = Nothing As IO.TextWriter Index: /trunk/ab5.0/ablib/src/Classes/System/IO/StreamWriter.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/System/IO/StreamWriter.ab (revision 621) +++ /trunk/ab5.0/ablib/src/Classes/System/IO/StreamWriter.ab (revision 622) @@ -30,4 +30,13 @@ init(stream) End Sub + + /* + @brief 基になるストリームを取得する + @date 2008/09/02 + @auther NoWest + */ + Function BaseStream () As Stream + Return s + End Function Override Sub Flush() Index: /trunk/ab5.0/ablib/src/api_console.sbp =================================================================== --- /trunk/ab5.0/ablib/src/api_console.sbp (revision 621) +++ /trunk/ab5.0/ablib/src/api_console.sbp (revision 622) @@ -183,12 +183,12 @@ Declare Function ReadConsoleInput Lib "kernel32" Alias _FuncName_ReadConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL Declare Function WriteConsoleInput Lib "kernel32" Alias _FuncName_WriteConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsWritten As DWord) As BOOL -Declare Function ReadConsoleOutput Lib "kernel32" Alias _FuncName_ReadConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpReadRegion As SMALL_RECT) As BOOL -Declare Function WriteConsoleOutput Lib "kernel32" Alias _FuncName_WriteConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpWriteRegion As SMALL_RECT) As BOOL -Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias _FuncName_ReadConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfCharsRead As DWord) As BOOL -Declare Function ReadConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfAttrsRead As DWord) As BOOL -Declare Function WriteConsoleOutputCharacter Lib "kernel32" Alias _FuncName_WriteConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL -Declare Function WriteConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL -Declare Function FillConsoleOutputCharacter Lib "kernel32" Alias _FuncName_FillConsoleOutputCharacter (hConsoleOutput As HANDLE, cCharacter As Char, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL -Declare Function FillConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttribute As Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL +Declare Function ReadConsoleOutput Lib "kernel32" Alias _FuncName_ReadConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, dwBufferSize As DWord, dwBufferCoord As DWord, ByRef lpReadRegion As SMALL_RECT) As BOOL +Declare Function WriteConsoleOutput Lib "kernel32" Alias _FuncName_WriteConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, dwBufferSize As DWord, dwBufferCoord As DWord, ByRef lpWriteRegion As SMALL_RECT) As BOOL +Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias _FuncName_ReadConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, dwReadCoord As DWord, ByRef lpNumberOfCharsRead As DWord) As BOOL +Declare Function ReadConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, dwReadCoord As DWord, ByRef lpNumberOfAttrsRead As DWord) As BOOL +Declare Function WriteConsoleOutputCharacter Lib "kernel32" Alias _FuncName_WriteConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfCharsWritten As DWord) As BOOL +Declare Function WriteConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfAttrsWritten As DWord) As BOOL +Declare Function FillConsoleOutputCharacter Lib "kernel32" Alias _FuncName_FillConsoleOutputCharacter (hConsoleOutput As HANDLE, cCharacter As Char, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfCharsWritten As DWord) As BOOL +Declare Function FillConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttribute As Word, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfAttrsWritten As DWord) As BOOL Declare Function GetConsoleMode Lib "kernel32" (hConsoleHandle As HANDLE, ByRef lpMode As DWord) As BOOL Declare Function GetNumberOfConsoleInputEvents Lib "kernel32" (hConsoleInput As HANDLE, ByRef lpNumberOfEvents As DWord) As BOOL @@ -222,2 +222,6 @@ Declare Function GetConsoleOutputCP Lib "kernel32" () As DWord Declare Function SetConsoleOutputCP Lib "kernel32" (wCodePageID As DWord) As BOOL + +Function COORDtoDWORD ( ByRef coord As COORD) As DWord + Return GetDWord(VarPtr(coord)) +End Function