Changeset 627


Ignore:
Timestamp:
2008/09/18 04:01:32 (4 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.