Changeset 627 for trunk/ab5.0


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
Files:
4 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

  • trunk/ab5.0/ablib/src/basic/dos_console.sbp

    r606 r627  
    66#define _INC_DOS_CONSOLE
    77
    8 
    9 Dim _System_hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
    10 Dim _System_hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
    11 Dim _System_hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
    12 System.Console.SetError(
    13      System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(
    14         New System.IO.FileStream(_System_hConsoleErr, System.IO.FileAccess.Write, False))))
    15 
    16 System.Console.SetOut(
    17      System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(
    18         New System.IO.FileStream(_System_hConsoleOut, System.IO.FileAccess.Write, False))))
    19 System.Console.SetIn(
    20     System.IO.TextReader.Synchronized(New System.IO.StreamReader(
    21         New System.IO.FileStream(_System_hConsoleIn, System.IO.FileAccess.Read, False))))
     8System.Console.OpenStandardError()
     9System.Console.OpenStandardInput()
     10System.Console.OpenStandardOutput()
    2211
    2312'---------- command.sbp内で定義済み ----------
    … …  
    5544End Sub
    5645
     46/*
     47@brief コンソール出力の内容を削除
     48@date 2008/9/18
     49@auther NoWest
     50*/
     51Macro CLS()(num As Long)
     52    Select Case num
     53        Case 2
     54            Exit Macro
     55        Case Else
     56            System.Console.Clear()
     57    End Select
     58End Macro
     59
     60/*
     61@brief コンソール出力の前景色・背景色を変更
     62@date 2008/9/18
     63@auther NoWest
     64*/
     65Macro COLOR(TextColorCode As Long)(BackColorCode=-1 As Long)
     66    Select Case TextColorCode
     67        Case 1
     68            System.Console.ForegroundColor = System.ConsoleColor.Blue
     69        Case 2
     70            System.Console.ForegroundColor = System.ConsoleColor.Red
     71        Case 3
     72            System.Console.ForegroundColor = System.ConsoleColor.Magenta
     73        Case 4
     74            System.Console.ForegroundColor = System.ConsoleColor.Green
     75        Case 5
     76            System.Console.ForegroundColor = System.ConsoleColor.Cyan
     77        Case 6
     78            System.Console.ForegroundColor = System.ConsoleColor.Yellow
     79        Case 7
     80            System.Console.ForegroundColor = System.ConsoleColor.Gray
     81        Case Else
     82            System.Console.ForegroundColor = System.ConsoleColor.Black
     83    End Select
     84
     85    Select Case BackColorCode
     86        Case -1
     87            Exit Macro
     88        Case 1
     89            System.Console.BackgroundColor = System.ConsoleColor.Blue
     90        Case 2
     91            System.Console.BackgroundColor = System.ConsoleColor.Red
     92        Case 3
     93            System.Console.BackgroundColor = System.ConsoleColor.Magenta
     94        Case 4
     95            System.Console.BackgroundColor = System.ConsoleColor.Green
     96        Case 5
     97            System.Console.BackgroundColor = System.ConsoleColor.Cyan
     98        Case 6
     99            System.Console.BackgroundColor = System.ConsoleColor.Yellow
     100        Case 7
     101            System.Console.BackgroundColor = System.ConsoleColor.Gray
     102        Case Else
     103            System.Console.BackgroundColor = System.ConsoleColor.Black
     104    End Select
     105End Macro
     106
     107/*
     108@brief コンソール出力のカーソル位置を変更
     109@date 2008/9/18
     110@auther NoWest
     111*/
    57112Macro LOCATE(x As Long, y As Long)
    58     SetConsoleCursorPosition(_System_hConsoleOut, MAKELONG(x, y))
     113    System.Console.SetCursorPosition(x,y)
    59114End Macro
    60115
Note: See TracChangeset for help on using the changeset viewer.