Ignore:
Timestamp:
Sep 18, 2008, 4:01:32 AM (16 years ago)
Author:
NoWest
Message:

さらにConsoleクラスを強化しました。
また、COLOR命令、CLS命令、LOCATE命令に対応しました。
PRINT命令はStringクラスのみ対応ですが、一応BASICの命令だけで色々できるようになりました。

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

Legend:

Unmodified
Added
Removed

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

    r623 r627  
    2727    Magenta     = FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
    2828End Enum
     29
    2930
    3031/*
    … …  
    4445            Exit Sub
    4546        Else
    46             Dim h = This.GetStdOutputHandle()
    47             If h = NULL Then
     47            If Console.hconsoleout = NULL Then
    4848                Exit Sub
    4949            Else
    5050                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    51                 Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     51                Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    5252                If ret = 0 Then Throw New IO.IOException()
    5353                csbi.wAttributes And = &HFF0F'背景色だけ変更できるようにマスク処理
    54                 ret = SetConsoleTextAttribute(h,csbi.wAttributes Or (This.ConsoleColorToTextAttribute(value)<<4) As Word/* foreをbackへ変換 */)         
     54                ret = SetConsoleTextAttribute(Console.hconsoleout,csbi.wAttributes Or (This.ConsoleColorToTextAttribute(value)<<4) As Word/* foreをbackへ変換 */)           
    5555                If ret = 0 Then Throw New IO.IOException()
    5656            End If
    … …  
    6161            Return ConsoleColor.Gray
    6262        Else
    63             Dim h = This.GetStdOutputHandle()
    64             If h = NULL Then
     63            If Console.hconsoleout = NULL Then
    6564                Return ConsoleColor.Gray
    6665            Else
    6766                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    68                 Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     67                Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    6968                If ret = 0 Then Throw New IO.IOException()
    7069                Dim attributes = csbi.wAttributes And &H00F0'背景色だけ取り出せるようにマスク処理
    … …  
    104103        Dim width As Long, height As Long
    105104        This.GetBufferSize(width,height)
    106         Return height
     105        Return width
    107106    End Function
    108107
    … …  
    129128    */
    130129    Static Sub CursorSize ( value As Long )
    131         Dim h = This.GetStdOutputHandle()
    132         If h = NULL Then
     130        If Console.hconsoleout = NULL Then
    133131            Exit Sub
    134132        Else
    135133            Dim cci As CONSOLE_CURSOR_INFO
    136             Dim ret = GetConsoleCursorInfo(h,cci)
     134            Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
    137135            If ret = 0 Then Throw New IO.IOException()
    138136            cci.dwSize = value As DWord
    139             ret = SetConsoleCursorInfo(h,cci)
     137            ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
    140138            If ret = 0 Then Throw New IO.IOException()
    141139        End If
    142140    End Sub
    143141    Static Function CursorSize () As Long
    144         Dim h = This.GetStdOutputHandle()
    145         If h = NULL Then
     142        If Console.hconsoleout = NULL Then
    146143            Return -1 As Long
    147144        Else
    148145            Dim cci As CONSOLE_CURSOR_INFO
    149             Dim ret = GetConsoleCursorInfo(h,cci)
     146            Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
    150147            If ret = 0 Then Throw New IO.IOException()
    151148            Return cci.dwSize As Long
    … …  
    175172    */
    176173    Static Sub CursorVisible ( visible As Boolean )
    177         Dim h = This.GetStdOutputHandle()
    178         If h = NULL Then
     174        If Console.hconsoleout = NULL Then
    179175            Exit Sub
    180176        Else
    181177            Dim cci As CONSOLE_CURSOR_INFO
    182             Dim ret = GetConsoleCursorInfo(h,cci)
     178            Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
    183179            If ret = 0 Then Throw New IO.IOException()
    184180            cci.bVisible = visible As BOOL
    185             ret = SetConsoleCursorInfo(h,cci)
     181            ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
    186182            If ret = 0 Then Throw New IO.IOException()
    187183        End If
    188184    End Sub
    189185    Static Function CursorVisible () As Boolean
    190         Dim h = This.GetStdOutputHandle()
    191         If h = NULL Then
     186        If Console.hconsoleout = NULL Then
    192187            Return False
    193188        Else
    194189            Dim cci As CONSOLE_CURSOR_INFO
    195             Dim ret = GetConsoleCursorInfo(h,cci)
     190            Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
    196191            If ret = 0 Then Throw New IO.IOException()
    197192            Return cci.bVisible As Boolean
    … …  
    208203            Exit Sub
    209204        Else
    210             Dim h = This.GetStdOutputHandle()
    211             If h = NULL Then
     205            If Console.hconsoleout = NULL Then
    212206                Exit Sub
    213207            Else
    214208                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    215                 Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     209                Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    216210                If ret = 0 Then Throw New IO.IOException()
    217211                csbi.wAttributes And = &HFFF0'前景色だけ変更できるようにマスク処理
    218                 ret = SetConsoleTextAttribute(h,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value))           
     212                ret = SetConsoleTextAttribute(Console.hconsoleout,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value))         
    219213                If ret = 0 Then Throw New IO.IOException()
    220214            End If
    … …  
    225219            Return ConsoleColor.Gray
    226220        Else
    227             Dim h = This.GetStdOutputHandle()
    228             If h = NULL Then
     221            If Console.hconsoleout = NULL Then
    229222                Return ConsoleColor.Gray
    230223            Else
    231224                Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    232                 Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     225                Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    233226                If ret = 0 Then Throw New IO.IOException()
    234227                Dim attributes = csbi.wAttributes And &H000F'前景色だけ取り出せるようにマスク処理
    … …  
    244237    */
    245238    Static Sub Title( title As String )
    246         Dim h = This.GetStdOutputHandle()
    247         If h=NULL Then
     239        If Console.hconsoleout =NULL Then
    248240            Exit Sub
    249241        Else
    … …  
    253245    Static Function Title() As String
    254246        Dim sb = New Text.StringBuilder(24500*SizeOf(Char))
    255         Dim h = This.GetStdOutputHandle()
    256         If h=NULL Then
     247        If Console.hconsoleout =NULL Then
    257248            Return ""
    258249        Else
    … …  
    271262            Throw New ArgumentNullException("newErr")
    272263        End If
    273         err = newErr
     264        Console.err = newErr
     265        Dim sw = Console.err As IO.StreamWriter
     266        Dim fs = sw.BaseStream() As IO.FileStream
     267        Console.hconsoleerr = fs.Handle()
    274268    End Sub
    275269
    … …  
    292286            Throw New ArgumentNullException("newOut")
    293287        End If
    294         out = newOut
     288        Console.out = newOut
     289        Dim sw = Console.out As IO.StreamWriter
     290        Dim fs = sw.BaseStream() As IO.FileStream
     291        Console.hconsoleout = fs.Handle()
    295292    End Sub
    296293
    … …  
    434431            Throw New ArgumentNullException("newIn")
    435432        End If
    436         in = newIn
     433        Console.in = newIn
     434        Dim sr = Console.in As IO.StreamReader
     435        Dim fs = sr.BaseStream() As IO.FileStream
     436        Console.hconsolein = fs.Handle()
    437437    End Sub
    438438
    … …  
    465465
    466466    /*
    467     @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア
    468     @date 2008/09/02
     467    @brief  コンソール バッファおよび対応するコンソール ウィンドウをクリア
     468    @date   2008/09/02
    469469    @auther NoWest
    470470    */
    471471    Static Sub Clear()
    472         Dim h = This.GetStdOutputHandle()
    473         If h = NULL Then
     472        If Console.hconsoleout = NULL Then
    474473            Exit Sub
    475474        Else
    476475            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    477             Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     476            Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    478477            If ret = 0 Then Throw New IO.IOException()
    479478            Dim length = csbi.dwSize.X * csbi.dwSize.Y
    480479            Dim written As DWord
    481480            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
     481            ret = FillConsoleOutputCharacter(Console.hconsoleout,s[0],length,0,written)
     482            If ret = 0 Then Throw New IO.IOException()
     483            ret = FillConsoleOutputAttribute(Console.hconsoleout,csbi.wAttributes,length,0,written)
     484            If ret = 0 Then Throw New IO.IOException()
     485            ret = SetConsoleCursorPosition(Console.hconsoleout,0)
     486            If ret = 0 Then Throw New IO.IOException()
     487        End If
     488    End Sub
     489
     490    /*
     491    @brief  標準エラー ストリームを取得
     492    @date   2008/09/07
     493    @auther NoWest
     494    */
     495    Static Sub OpenStandardError()
     496        Console.SetError(System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(New System.IO.FileStream(GetStdHandle(STD_ERROR_HANDLE), System.IO.FileAccess.Write, False))))
     497    End Sub
     498
     499    /*
     500    @brief  標準入力ストリーム ストリームを取得
     501    @date   2008/09/07
     502    @auther NoWest
     503    */
     504    Static Sub OpenStandardInput()
     505        Console.SetIn(System.IO.TextReader.Synchronized(New System.IO.StreamReader(New System.IO.FileStream(GetStdHandle(STD_INPUT_HANDLE), System.IO.FileAccess.Read, False))))
     506    End Sub
     507
     508    /*
     509    @brief  標準出力ストリーム ストリームを取得
     510    @date   2008/09/07
     511    @auther NoWest
     512    */
     513    Static Sub OpenStandardOutput()
     514        Console.SetOut(System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(New System.IO.FileStream(GetStdHandle(STD_OUTPUT_HANDLE), System.IO.FileAccess.Write, False))))
     515    End Sub
     516
     517    /*
     518    @brief  コンソールの前景色および背景色を既定値に設定(前景色=gray 背景色=black)
     519    @date   2008/09/07
     520    @auther NoWest
     521    */
     522    Static Sub ResetColor()
     523        Console.BackgroundColor(ConsoleColor.Black)
     524        Console.ForegroundColor(ConsoleColor.Gray)
    489525    End Sub
    490526
    … …  
    495531    */
    496532    Static Sub SetBufferSize ( width As Long, height As Long )
    497         Dim h = This.GetStdOutputHandle()
    498         If h = NULL Then
     533        If Console.hconsoleout = NULL Then
    499534            Exit Sub
    500535        Else
    … …  
    502537            size.X = width As Integer
    503538            size.Y = height As Integer
    504             Dim ret = SetConsoleScreenBufferSize(h,COORDtoDWORD(size))
     539            Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
    505540            If ret = 0 Then Throw New IO.IOException()
    506541        End If
    … …  
    513548    */
    514549    Static Sub SetCursorPosition ( left As Long, top As Long )
    515         Dim h = This.GetStdOutputHandle()
    516         If h = NULL Then
     550        If Console.hconsoleout = NULL Then
    517551            Exit Sub
    518552        Else
    … …  
    520554            pos.X = left As Integer
    521555            pos.Y = top As Integer
    522             Dim ret = SetConsoleCursorPosition(h,COORDtoDWORD(pos))
     556            Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
    523557            If ret = 0 Then Throw New IO.IOException()
    524558        End If
    … …  
    539573        End If
    540574        enter = cs.Enter
    541     End Function
    542 
    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()
    547575    End Function
    548576
    … …  
    592620
    593621    Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
    594         Dim h = This.GetStdOutputHandle()
    595         If h = NULL Then
     622        If Console.hconsoleout = NULL Then
    596623            Exit Sub
    597624        Else
    598625            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    599             Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     626            Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    600627            If ret = 0 Then Throw New IO.IOException()
    601628            left = csbi.dwCursorPosition.X
    … …  
    605632
    606633    Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
    607         Dim h = This.GetStdOutputHandle()
    608         If h = NULL Then
     634        If Console.hconsoleout = NULL Then
    609635            Exit Sub
    610636        Else
    611637            Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    612             Dim ret = GetConsoleScreenBufferInfo(h,csbi)
     638            Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
    613639            If ret = 0 Then Throw New IO.IOException()
    614640            width = csbi.dwSize.X
    … …  
    617643    End Sub
    618644
     645    Static hconsoleerr = NULL As HANDLE
     646    Static hconsolein = NULL As HANDLE
     647    Static hconsoleout = NULL As HANDLE
    619648    Static in = Nothing As IO.TextReader
    620649    Static out = Nothing As IO.TextWriter

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

    r605 r627  
    2727        init(stream)
    2828    End Sub
     29
     30Public
     31    /*
     32    @brief 基になるストリームを取得する
     33    @date 2008/09/02
     34    @auther NoWest
     35    */
     36    Function BaseStream () As Stream
     37        Return s
     38    End Function
    2939
    3040    /*

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

    r622 r627  
    3636    @auther NoWest
    3737    */
    38     Function BaseStream () As Stream
     38    Function BaseStream () As System.IO.Stream
    3939        Return s
    4040    End Function
Note: See TracChangeset for help on using the changeset viewer.