Changeset 622 for trunk/ab5.0


Ignore:
Timestamp:
Sep 4, 2008, 7:05:21 AM (16 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.