Changeset 622 for trunk/ab5.0/ablib/src/Classes
- Timestamp:
- Sep 4, 2008, 7:05:21 AM (16 years ago)
- Location:
- trunk/ab5.0/ablib/src/Classes/System
- Files:
-
- 2 edited
-
Console.ab (modified) (4 diffs)
-
IO/StreamWriter.ab (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/System/Console.ab
r606 r622 2 2 3 3 Namespace System 4 5 Enum 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 28 End Enum 4 29 5 30 /* … … 11 36 Public 12 37 /* 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 /* 13 265 @brief 標準エラー出力を設定する 14 266 @date 2008/08/21 … … 211 463 Read = in.Read() 212 464 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 213 526 214 527 Private … … 228 541 End Function 229 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() 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 230 619 Static in = Nothing As IO.TextReader 231 620 Static out = Nothing As IO.TextWriter -
trunk/ab5.0/ablib/src/Classes/System/IO/StreamWriter.ab
r476 r622 30 30 init(stream) 31 31 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 32 41 33 42 Override Sub Flush()
Note:
See TracChangeset
for help on using the changeset viewer.
