Changeset 622


Ignore:
Timestamp:
2008/09/04 07:05:21 (4 years ago)
Author:
NoWest
Message:

Consoleクラスを強化

Location:
trunk/ab5.0/ablib/src
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/ab5.0/ablib/src/Classes/System/Console.ab

    r606 r622  
    22 
    33Namespace System 
     4 
     5Enum ConsoleColor 
     6    Black       = 0  
     7    DarkGray    = FOREGROUND_INTENSITY 
     8    Gray        = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE 
     9    White       = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     10 
     11    DarkRed     = FOREGROUND_RED 
     12    Red         = FOREGROUND_RED Or FOREGROUND_INTENSITY 
     13 
     14    DarkYellow  = FOREGROUND_RED Or FOREGROUND_GREEN 
     15    Yellow      = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     16 
     17    DarkGreen   = FOREGROUND_GREEN 
     18    Green       = FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     19 
     20    DarkCyan    = FOREGROUND_GREEN Or FOREGROUND_BLUE 
     21    Cyan        = FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     22 
     23    DarkBlue    = FOREGROUND_BLUE 
     24    Blue        = FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     25 
     26    DarkMagenta = FOREGROUND_RED Or FOREGROUND_BLUE 
     27    Magenta     = FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     28End Enum 
    429 
    530/* 
    … …  
    1136Public 
    1237    /* 
     38    @brief コンソールの背景色を取得または設定する 
     39    @date 2008/09/02 
     40    @auther NoWest 
     41    */ 
     42    Static Sub BackgroundColor ( value As ConsoleColor ) 
     43        If ActiveBasic.IsNothing(Console.out) Then 
     44            Exit Sub 
     45        Else 
     46            Dim h = This.GetStdOutputHandle() 
     47            If h = NULL Then 
     48                Exit Sub 
     49            Else 
     50                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     51                Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     52                If ret = 0 Then Throw New IO.IOException() 
     53                csbi.wAttributes And = &HFF0F'背景色だけ変更できるようにマスク処理 
     54                ret = SetConsoleTextAttribute(h,csbi.wAttributes Or (This.ConsoleColorToTextAttribute(value)<<4) As Word/* foreをbackへ変換 */)          
     55                If ret = 0 Then Throw New IO.IOException() 
     56            End If 
     57        End If 
     58    End Sub 
     59    Static Function BackgroundColor() As ConsoleColor 
     60        If ActiveBasic.IsNothing(Console.out) Then 
     61            Return ConsoleColor.Gray 
     62        Else 
     63            Dim h = This.GetStdOutputHandle() 
     64            If h = NULL Then 
     65                Return ConsoleColor.Gray 
     66            Else 
     67                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     68                Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     69                If ret = 0 Then Throw New IO.IOException() 
     70                Dim attributes = csbi.wAttributes And &H00F0'背景色だけ取り出せるようにマスク処理 
     71                Return This.TextAttributeToConsoleColor(attributes>>4/* backをforeへ変換 */) 
     72            End If 
     73        End If 
     74    End Function 
     75 
     76 
     77    /* 
     78    @brief バッファ領域の高さを取得または設定する 
     79    @date 2008/09/02 
     80    @auther NoWest 
     81    */ 
     82    Static Sub BufferHeight ( value As Long ) 
     83        Dim width As Long, height As Long 
     84        This.GetBufferSize(width,height) 
     85        Console.SetBufferSize(width,value) 
     86    End Sub 
     87    Static Function BufferHeight () As Long 
     88        Dim width As Long, height As Long 
     89        This.GetBufferSize(width,height) 
     90        Return height 
     91    End Function 
     92 
     93    /* 
     94    @brief バッファ領域の幅を取得または設定する 
     95    @date 2008/09/02 
     96    @auther NoWest 
     97    */ 
     98    Static Sub BufferWidth ( value As Long ) 
     99        Dim width As Long, height As Long 
     100        This.GetBufferSize(width,height) 
     101        Console.SetBufferSize(value,height) 
     102    End Sub 
     103    Static Function BufferWidth () As Long 
     104        Dim width As Long, height As Long 
     105        This.GetBufferSize(width,height) 
     106        Return height 
     107    End Function 
     108 
     109    /* 
     110    @brief カーソルの列位置を取得または設定する 
     111    @date 2008/09/02 
     112    @auther NoWest 
     113    */ 
     114    Static Sub CursorLeft ( value As Long ) 
     115        Dim left As Long, top As Long 
     116        This.GetCursorPosition(left,top) 
     117        Console.SetCursorPosition(value,top) 
     118    End Sub 
     119    Static Function CursorLeft () As Long 
     120        Dim left As Long, top As Long 
     121        This.GetCursorPosition(left,top) 
     122        Return left 
     123    End Function 
     124 
     125    /* 
     126    @brief 文字セル内のカーソルの高さを取得または設定する 
     127    @date 2008/09/02 
     128    @auther NoWest 
     129    */ 
     130    Static Sub CursorSize ( value As Long ) 
     131        Dim h = This.GetStdOutputHandle() 
     132        If h = NULL Then 
     133            Exit Sub 
     134        Else 
     135            Dim cci As CONSOLE_CURSOR_INFO 
     136            Dim ret = GetConsoleCursorInfo(h,cci) 
     137            If ret = 0 Then Throw New IO.IOException() 
     138            cci.dwSize = value As DWord 
     139            ret = SetConsoleCursorInfo(h,cci) 
     140            If ret = 0 Then Throw New IO.IOException() 
     141        End If 
     142    End Sub 
     143    Static Function CursorSize () As Long 
     144        Dim h = This.GetStdOutputHandle() 
     145        If h = NULL Then 
     146            Return -1 As Long 
     147        Else 
     148            Dim cci As CONSOLE_CURSOR_INFO 
     149            Dim ret = GetConsoleCursorInfo(h,cci) 
     150            If ret = 0 Then Throw New IO.IOException() 
     151            Return cci.dwSize As Long 
     152        End If 
     153    End Function 
     154 
     155    /* 
     156    @brief カーソルの行位置を取得または設定する 
     157    @date 2008/09/02 
     158    @auther NoWest 
     159    */ 
     160    Static Sub CursorTop ( value As Long ) 
     161        Dim left As Long, top As Long 
     162        This.GetCursorPosition(left,top) 
     163        Console.SetCursorPosition(left,value) 
     164    End Sub 
     165    Static Function CursorTop () As Long 
     166        Dim left As Long, top As Long 
     167        This.GetCursorPosition(left,top) 
     168        Return top 
     169    End Function 
     170 
     171    /* 
     172    @brief カーソルを表示するかどうかを示す値を取得または設定する 
     173    @date 2008/09/02 
     174    @auther NoWest 
     175    */ 
     176    Static Sub CursorVisible ( visible As Boolean ) 
     177        Dim h = This.GetStdOutputHandle() 
     178        If h = NULL Then 
     179            Exit Sub 
     180        Else 
     181            Dim cci As CONSOLE_CURSOR_INFO 
     182            Dim ret = GetConsoleCursorInfo(h,cci) 
     183            If ret = 0 Then Throw New IO.IOException() 
     184            cci.bVisible = visible As BOOL 
     185            ret = SetConsoleCursorInfo(h,cci) 
     186            If ret = 0 Then Throw New IO.IOException() 
     187        End If 
     188    End Sub 
     189    Static Function CursorVisible () As Boolean 
     190        Dim h = This.GetStdOutputHandle() 
     191        If h = NULL Then 
     192            Return False 
     193        Else 
     194            Dim cci As CONSOLE_CURSOR_INFO 
     195            Dim ret = GetConsoleCursorInfo(h,cci) 
     196            If ret = 0 Then Throw New IO.IOException() 
     197            Return cci.bVisible As Boolean 
     198        End If 
     199    End Function 
     200 
     201    /* 
     202    @brief コンソールの前景色を取得または設定する 
     203    @date 2008/09/02 
     204    @auther NoWest 
     205    */ 
     206    Static Sub ForegroundColor ( value As ConsoleColor ) 
     207        If ActiveBasic.IsNothing(Console.out) Then 
     208            Exit Sub 
     209        Else 
     210            Dim h = This.GetStdOutputHandle() 
     211            If h = NULL Then 
     212                Exit Sub 
     213            Else 
     214                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     215                Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     216                If ret = 0 Then Throw New IO.IOException() 
     217                csbi.wAttributes And = &HFFF0'前景色だけ変更できるようにマスク処理 
     218                ret = SetConsoleTextAttribute(h,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value))             
     219                If ret = 0 Then Throw New IO.IOException() 
     220            End If 
     221        End If 
     222    End Sub 
     223    Static Function ForegroundColor() As ConsoleColor 
     224        If ActiveBasic.IsNothing(Console.out) Then 
     225            Return ConsoleColor.Gray 
     226        Else 
     227            Dim h = This.GetStdOutputHandle() 
     228            If h = NULL Then 
     229                Return ConsoleColor.Gray 
     230            Else 
     231                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     232                Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     233                If ret = 0 Then Throw New IO.IOException() 
     234                Dim attributes = csbi.wAttributes And &H000F'前景色だけ取り出せるようにマスク処理 
     235                Return This.TextAttributeToConsoleColor(attributes) 
     236            End If 
     237        End If 
     238    End Function 
     239 
     240    /* 
     241    @brief コンソールのタイトルを取得または設定する 
     242    @date 2008/09/02 
     243    @auther NoWest 
     244    */ 
     245    Static Sub Title( title As String ) 
     246        Dim h = This.GetStdOutputHandle() 
     247        If h=NULL Then 
     248            Exit Sub 
     249        Else 
     250            SetConsoleTitle(StrPtr(title)) 
     251        End If 
     252    End Sub 
     253    Static Function Title() As String 
     254        Dim sb = New Text.StringBuilder(24500*SizeOf(Char)) 
     255        Dim h = This.GetStdOutputHandle() 
     256        If h=NULL Then 
     257            Return "" 
     258        Else 
     259            GetConsoleTitle(sb.__Chars(),sb.Length()) 
     260        End If 
     261    End Function 
     262 
     263 
     264    /* 
    13265    @brief 標準エラー出力を設定する 
    14266    @date 2008/08/21 
    … …  
    211463        Read = in.Read() 
    212464    End Function 
     465 
     466    /* 
     467    @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア 
     468    @date 2008/09/02 
     469    @auther NoWest 
     470    */ 
     471    Static Sub Clear() 
     472        Dim h = This.GetStdOutputHandle() 
     473        If h = NULL Then 
     474            Exit Sub 
     475        Else 
     476            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     477            Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     478            If ret = 0 Then Throw New IO.IOException() 
     479            Dim length = csbi.dwSize.X * csbi.dwSize.Y 
     480            Dim written As DWord 
     481            Dim s = New String(" ") 
     482            ret = FillConsoleOutputCharacter(h,s[0],length,0,written) 
     483            If ret = 0 Then Throw New IO.IOException() 
     484            ret = FillConsoleOutputAttribute(h,csbi.wAttributes,length,0,written) 
     485            If ret = 0 Then Throw New IO.IOException() 
     486            ret = SetConsoleCursorPosition(h,0) 
     487            If ret = 0 Then Throw New IO.IOException() 
     488        End If 
     489    End Sub 
     490 
     491    /* 
     492    @brief バッファ領域の高さと幅を指定された値に設定 
     493    @date 2008/09/02 
     494    @auther NoWest 
     495    */ 
     496    Static Sub SetBufferSize ( width As Long, height As Long ) 
     497        Dim h = This.GetStdOutputHandle() 
     498        If h = NULL Then 
     499            Exit Sub 
     500        Else 
     501            Dim size As COORD 
     502            size.X = width As Integer 
     503            size.Y = height As Integer 
     504            Dim ret = SetConsoleScreenBufferSize(h,COORDtoDWORD(size)) 
     505            If ret = 0 Then Throw New IO.IOException() 
     506        End If 
     507    End Sub 
     508 
     509    /* 
     510    @brief カーソルの位置を設定 
     511    @date 2008/09/02 
     512    @auther NoWest 
     513    */ 
     514    Static Sub SetCursorPosition ( left As Long, top As Long ) 
     515        Dim h = This.GetStdOutputHandle() 
     516        If h = NULL Then 
     517            Exit Sub 
     518        Else 
     519            Dim pos As COORD 
     520            pos.X = left As Integer 
     521            pos.Y = top As Integer 
     522            Dim ret = SetConsoleCursorPosition(h,COORDtoDWORD(pos)) 
     523            If ret = 0 Then Throw New IO.IOException() 
     524        End If 
     525    End Sub 
    213526 
    214527Private 
    … …  
    228541    End Function 
    229542 
     543    Function GetStdOutputHandle() As HANDLE 
     544        Dim sw = Console.out As IO.StreamWriter 
     545        Dim fs = sw.BaseStream() As IO.FileStream 
     546        Return fs.Handle() 
     547    End Function 
     548 
     549    Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word 
     550        Dim ret = value As DWord 
     551        Return ret As Word 
     552    End Function 
     553 
     554    Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor 
     555        Select Case value 
     556            Case 0 
     557                Return ConsoleColor.Black 
     558            Case FOREGROUND_INTENSITY 
     559                Return ConsoleColor.DarkGray 
     560            Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE 
     561                Return ConsoleColor.Gray 
     562            Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     563                Return ConsoleColor.White 
     564            Case FOREGROUND_RED 
     565                Return ConsoleColor.DarkRed 
     566            Case FOREGROUND_RED Or FOREGROUND_INTENSITY 
     567                Return ConsoleColor.Red 
     568            Case FOREGROUND_RED Or FOREGROUND_GREEN 
     569                Return ConsoleColor.DarkYellow 
     570            Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     571                Return ConsoleColor.Yellow 
     572            Case FOREGROUND_GREEN 
     573                Return ConsoleColor.DarkGreen 
     574            Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     575                Return ConsoleColor.Green 
     576            Case FOREGROUND_GREEN Or FOREGROUND_BLUE 
     577                Return ConsoleColor.DarkCyan 
     578            Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     579                Return ConsoleColor.Cyan 
     580            Case FOREGROUND_BLUE 
     581                Return ConsoleColor.DarkBlue 
     582            Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY 
     583                Return ConsoleColor.Blue 
     584            Case FOREGROUND_RED Or FOREGROUND_BLUE 
     585                Return ConsoleColor.DarkMagenta 
     586            Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY 
     587                Return ConsoleColor.Magenta 
     588            Case Else 
     589                Return ConsoleColor.Gray 
     590        End Select 
     591    End Function 
     592 
     593    Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long ) 
     594        Dim h = This.GetStdOutputHandle() 
     595        If h = NULL Then 
     596            Exit Sub 
     597        Else 
     598            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     599            Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     600            If ret = 0 Then Throw New IO.IOException() 
     601            left = csbi.dwCursorPosition.X 
     602            top = csbi.dwCursorPosition.Y 
     603        End If 
     604    End Sub 
     605 
     606    Sub GetBufferSize ( ByRef width As Long, ByRef height As Long ) 
     607        Dim h = This.GetStdOutputHandle() 
     608        If h = NULL Then 
     609            Exit Sub 
     610        Else 
     611            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 
     612            Dim ret = GetConsoleScreenBufferInfo(h,csbi) 
     613            If ret = 0 Then Throw New IO.IOException() 
     614            width = csbi.dwSize.X 
     615            height = csbi.dwSize.Y 
     616        End If 
     617    End Sub 
     618 
    230619    Static in = Nothing As IO.TextReader 
    231620    Static out = Nothing As IO.TextWriter 

  • trunk/ab5.0/ablib/src/Classes/System/IO/StreamWriter.ab

    r476 r622  
    3030        init(stream) 
    3131    End Sub 
     32 
     33    /* 
     34    @brief 基になるストリームを取得する 
     35    @date 2008/09/02 
     36    @auther NoWest 
     37    */ 
     38    Function BaseStream () As Stream 
     39        Return s 
     40    End Function 
    3241 
    3342    Override Sub Flush() 

  • trunk/ab5.0/ablib/src/api_console.sbp

    r497 r622  
    183183Declare Function ReadConsoleInput Lib "kernel32" Alias _FuncName_ReadConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL 
    184184Declare Function WriteConsoleInput Lib "kernel32" Alias _FuncName_WriteConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsWritten As DWord) As BOOL 
    185 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 
    186 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 
    187 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 
    188 Declare Function ReadConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfAttrsRead As DWord) As BOOL 
    189 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 
    190 Declare Function WriteConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL 
    191 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 
    192 Declare Function FillConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttribute As Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL 
     185Declare 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 
     186Declare 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 
     187Declare 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 
     188Declare Function ReadConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, dwReadCoord As DWord, ByRef lpNumberOfAttrsRead As DWord) As BOOL 
     189Declare 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 
     190Declare Function WriteConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfAttrsWritten As DWord) As BOOL 
     191Declare 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 
     192Declare Function FillConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttribute As Word, nLength As DWord, dwWriteCoord As DWord, ByRef lpNumberOfAttrsWritten As DWord) As BOOL 
    193193Declare Function GetConsoleMode Lib "kernel32" (hConsoleHandle As HANDLE, ByRef lpMode As DWord) As BOOL 
    194194Declare Function GetNumberOfConsoleInputEvents Lib "kernel32" (hConsoleInput As HANDLE, ByRef lpNumberOfEvents As DWord) As BOOL 
    … …  
    222222Declare Function GetConsoleOutputCP Lib "kernel32" () As DWord 
    223223Declare Function SetConsoleOutputCP Lib "kernel32" (wCodePageID As DWord) As BOOL 
     224 
     225Function COORDtoDWORD ( ByRef coord As COORD) As DWord 
     226    Return GetDWord(VarPtr(coord)) 
     227End Function 
Note: See TracChangeset for help on using the changeset viewer.