source: trunk/ab5.0/ablib/src/Classes/System/Console.ab@ 636

Last change on this file since 636 was 636, checked in by NoWest, 16 years ago

Staticなメンバ変数にConsoleColorを指定するとなぜかエラーになるようなので、
直接文字列バッファの属性を保持する方法に変更しました。

これでResetColorの問題は直ったはずです。
File size: 17.2 KB
Line 
1'Classes/System/Console.ab
2
3Namespace 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_BLUE Or FOREGROUND_INTENSITY
28End Enum
29
30
31/*
32@brief コンソール入出力・ウィンドウなどのクラス
33@date 2008/02/26
34@auther Egtra
35*/
36Class Console
37Public
38 /*
39 @brief コンソールの背景色を取得または設定する
40 @date 2008/09/02
41 @auther NoWest
42 */
43 Static Sub BackgroundColor ( value As ConsoleColor )
44 If ActiveBasic.IsNothing(Console.out) Then
45 Exit Sub
46 Else
47 If Console.hconsoleout = NULL Then
48 Exit Sub
49 Else
50 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
51 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
52 If ret = 0 Then Throw New IO.IOException()
53 csbi.wAttributes And = &HFF0F'背景色だけ変更できるようにマスク処理
54 ret = SetConsoleTextAttribute(Console.hconsoleout,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 If Console.hconsoleout = NULL Then
64 Return ConsoleColor.Gray
65 Else
66 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
67 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
68 If ret = 0 Then Throw New IO.IOException()
69 Dim attributes = csbi.wAttributes And &H00F0'背景色だけ取り出せるようにマスク処理
70 Return This.TextAttributeToConsoleColor(attributes>>4/* backをforeへ変換 */)
71 End If
72 End If
73 End Function
74
75
76 /*
77 @brief バッファ領域の高さを取得または設定する
78 @date 2008/09/02
79 @auther NoWest
80 */
81 Static Sub BufferHeight ( value As Long )
82 Dim width As Long, height As Long
83 This.GetBufferSize(width,height)
84 Console.SetBufferSize(width,value)
85 End Sub
86 Static Function BufferHeight () As Long
87 Dim width As Long, height As Long
88 This.GetBufferSize(width,height)
89 Return height
90 End Function
91
92 /*
93 @brief バッファ領域の幅を取得または設定する
94 @date 2008/09/02
95 @auther NoWest
96 */
97 Static Sub BufferWidth ( value As Long )
98 Dim width As Long, height As Long
99 This.GetBufferSize(width,height)
100 Console.SetBufferSize(value,height)
101 End Sub
102 Static Function BufferWidth () As Long
103 Dim width As Long, height As Long
104 This.GetBufferSize(width,height)
105 Return width
106 End Function
107
108 /*
109 @brief カーソルの列位置を取得または設定する
110 @date 2008/09/02
111 @auther NoWest
112 */
113 Static Sub CursorLeft ( value As Long )
114 Dim left As Long, top As Long
115 This.GetCursorPosition(left,top)
116 Console.SetCursorPosition(value,top)
117 End Sub
118 Static Function CursorLeft () As Long
119 Dim left As Long, top As Long
120 This.GetCursorPosition(left,top)
121 Return left
122 End Function
123
124 /*
125 @brief 文字セル内のカーソルの高さを取得または設定する
126 @date 2008/09/02
127 @auther NoWest
128 */
129 Static Sub CursorSize ( value As Long )
130 If Console.hconsoleout = NULL Then
131 Exit Sub
132 Else
133 Dim cci As CONSOLE_CURSOR_INFO
134 Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
135 If ret = 0 Then Throw New IO.IOException()
136 cci.dwSize = value As DWord
137 ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
138 If ret = 0 Then Throw New IO.IOException()
139 End If
140 End Sub
141 Static Function CursorSize () As Long
142 If Console.hconsoleout = NULL Then
143 Return -1 As Long
144 Else
145 Dim cci As CONSOLE_CURSOR_INFO
146 Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
147 If ret = 0 Then Throw New IO.IOException()
148 Return cci.dwSize As Long
149 End If
150 End Function
151
152 /*
153 @brief カーソルの行位置を取得または設定する
154 @date 2008/09/02
155 @auther NoWest
156 */
157 Static Sub CursorTop ( value As Long )
158 Dim left As Long, top As Long
159 This.GetCursorPosition(left,top)
160 Console.SetCursorPosition(left,value)
161 End Sub
162 Static Function CursorTop () As Long
163 Dim left As Long, top As Long
164 This.GetCursorPosition(left,top)
165 Return top
166 End Function
167
168 /*
169 @brief カーソルを表示するかどうかを示す値を取得または設定する
170 @date 2008/09/02
171 @auther NoWest
172 */
173 Static Sub CursorVisible ( visible As Boolean )
174 If Console.hconsoleout = NULL Then
175 Exit Sub
176 Else
177 Dim cci As CONSOLE_CURSOR_INFO
178 Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
179 If ret = 0 Then Throw New IO.IOException()
180 cci.bVisible = visible As BOOL
181 ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
182 If ret = 0 Then Throw New IO.IOException()
183 End If
184 End Sub
185 Static Function CursorVisible () As Boolean
186 If Console.hconsoleout = NULL Then
187 Return False
188 Else
189 Dim cci As CONSOLE_CURSOR_INFO
190 Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
191 If ret = 0 Then Throw New IO.IOException()
192 Return cci.bVisible As Boolean
193 End If
194 End Function
195
196 /*
197 @brief コンソールの前景色を取得または設定する
198 @date 2008/09/02
199 @auther NoWest
200 */
201 Static Sub ForegroundColor ( value As ConsoleColor )
202 If ActiveBasic.IsNothing(Console.out) Then
203 Exit Sub
204 Else
205 If Console.hconsoleout = NULL Then
206 Exit Sub
207 Else
208 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
209 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
210 If ret = 0 Then Throw New IO.IOException()
211 csbi.wAttributes And = &HFFF0'前景色だけ変更できるようにマスク処理
212 ret = SetConsoleTextAttribute(Console.hconsoleout,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value))
213 If ret = 0 Then Throw New IO.IOException()
214 End If
215 End If
216 End Sub
217 Static Function ForegroundColor() As ConsoleColor
218 If ActiveBasic.IsNothing(Console.out) Then
219 Return ConsoleColor.Gray
220 Else
221 If Console.hconsoleout = NULL Then
222 Return ConsoleColor.Gray
223 Else
224 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
225 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
226 If ret = 0 Then Throw New IO.IOException()
227 Dim attributes = csbi.wAttributes And &H000F'前景色だけ取り出せるようにマスク処理
228 Return This.TextAttributeToConsoleColor(attributes)
229 End If
230 End If
231 End Function
232
233 /*
234 @brief コンソールのタイトルを取得または設定する
235 @date 2008/09/02
236 @auther NoWest
237 */
238 Static Sub Title( title As String )
239 If Console.hconsoleout =NULL Then
240 Exit Sub
241 Else
242 SetConsoleTitle(ToTCStr(title))
243 End If
244 End Sub
245 Static Function Title() As String
246 If Console.hconsoleout =NULL Then
247 Return ""
248 Else
249 Dim sb = New Text.StringBuilder
250 sb.Length = 24500
251 Dim ret = GetConsoleTitle(StrPtr(sb),sb.Length())
252 If ret = 0 Then
253 Dim error = GetLastError()
254 If error <> ERROR_SUCCESS Then
255 ActiveBasic.Windows.ThrowWithErrorCode(error, "Console.Title")
256 End If
257 End If
258 sb.Length = ret
259 Return sb.ToString()
260 End If
261 End Function
262
263
264 /*
265 @brief 標準エラー出力を設定する
266 @date 2008/08/21
267 @auther Egtra
268 */
269 Static Sub SetError(newErr As IO.TextWriter)
270 If ActiveBasic.IsNothing(newErr) Then
271 Throw New ArgumentNullException("newErr")
272 End If
273 Console.err = newErr
274 Dim sw = Console.err As IO.StreamWriter
275 Dim fs = sw.BaseStream() As IO.FileStream
276 Console.hconsoleerr = fs.Handle()
277 End Sub
278
279 /*
280 @brief 標準エラー出力を取得する
281 @date 2008/08/21
282 @auther Egtra
283 */
284 Static Function Error() As IO.TextWriter
285 Error = err
286 End Function
287
288 /*
289 @brief 標準出力を設定する
290 @date 2008/06/21
291 @auther overtaker
292 */
293 Static Sub SetOut(newOut As IO.TextWriter)
294 If ActiveBasic.IsNothing(newOut) Then
295 Throw New ArgumentNullException("newOut")
296 End If
297 Console.out = newOut
298 Dim sw = Console.out As IO.StreamWriter
299 Dim fs = sw.BaseStream() As IO.FileStream
300 Console.hconsoleout = fs.Handle()
301 End Sub
302
303 /*
304 @brief 標準出力を取得する
305 @date 2008/06/21
306 @auther overtaker
307 */
308 Static Function Out() As IO.TextWriter
309 Out = out
310 End Function
311
312 /*
313 @brief 標準出力に1行書き込む
314 @date 2008/06/21
315 @auther overtaker
316 */
317 Static Sub WriteLine(value As String)
318 out.WriteLine(value)
319 out.Flush()
320 End Sub
321
322 Static Sub WriteLine()
323 out.WriteLine()
324 out.Flush()
325 End Sub
326
327 Static Sub WriteLine(x As Boolean)
328 WriteLine(Str$(x))
329 End Sub
330
331 Static Sub WriteLine(x As Char)
332 WriteLine(Chr$(x))
333 End Sub
334
335 Static Sub WriteLine(x As Byte)
336 WriteLine(Str$(x))
337 End Sub
338#ifdef UNICODE
339 Static Sub WriteLine(x As SByte)
340 WriteLine(Str$(x))
341 End Sub
342#else
343 Static Sub WriteLine(x As Word)
344 WriteLine(Str$(x))
345 End Sub
346#endif
347 Static Sub WriteLine(x As Integer)
348 WriteLine(Str$(x))
349 End Sub
350
351 Static Sub WriteLine(x As DWord)
352 WriteLine(Str$(x))
353 End Sub
354
355 Static Sub WriteLine(x As Long)
356 WriteLine(Str$(x))
357 End Sub
358
359 Static Sub WriteLine(x As QWord)
360 WriteLine(Str$(x))
361 End Sub
362
363 Static Sub WriteLine(x As Int64)
364 WriteLine(Str$(x))
365 End Sub
366
367 Static Sub WriteLine(x As Single)
368 WriteLine(Str$(x))
369 End Sub
370
371 Static Sub WriteLine(x As Double)
372 WriteLine(Str$(x))
373 End Sub
374
375 Static Sub WriteLine(x As Object)
376 WriteLine(x.ToString)
377 End Sub
378
379 /*
380 @brief 標準出力に書き込む
381 @date 2008/06/21
382 @auther overtaker
383 */
384 Static Sub Write(s As String)
385 out.Write(s)
386 out.Flush()
387 End Sub
388
389 Static Sub Write(x As Boolean)
390 Write(Str$(x))
391 End Sub
392
393 Static Sub Write(x As Char)
394 Write(Chr$(x))
395 End Sub
396
397 Static Sub Write(x As Byte)
398 Write(Str$(x))
399 End Sub
400#ifdef UNICODE
401 Static Sub Write(x As SByte)
402 Write(Str$(x))
403 End Sub
404#else
405 Static Sub Write(x As Word)
406 Write(Str$(x))
407 End Sub
408#endif
409 Static Sub Write(x As Integer)
410 Write(Str$(x))
411 End Sub
412
413 Static Sub Write(x As DWord)
414 Write(Str$(x))
415 End Sub
416
417 Static Sub Write(x As Long)
418 Write(Str$(x))
419 End Sub
420
421 Static Sub Write(x As QWord)
422 Write(Str$(x))
423 End Sub
424
425 Static Sub Write(x As Int64)
426 Write(Str$(x))
427 End Sub
428
429 Static Sub Write(x As Object)
430 Write(x.ToString)
431 End Sub
432
433 /*
434 @brief 標準入力を設定する
435 @date 2008/02/26
436 @auther Egtra
437 */
438 Static Sub SetIn(newIn As IO.TextReader)
439 If ActiveBasic.IsNothing(newIn) Then
440 Throw New ArgumentNullException("newIn")
441 End If
442 Console.in = newIn
443 Dim sr = Console.in As IO.StreamReader
444 Dim fs = sr.BaseStream() As IO.FileStream
445 Console.hconsolein = fs.Handle()
446 End Sub
447
448 /*
449 @brief 標準入力を取得する
450 @date 2008/02/26
451 @auther Egtra
452 */
453 Static Function In() As IO.TextReader
454 In = in
455 End Function
456
457 /*
458 @brief 標準入力から1行読み込む
459 @date 2008/02/26
460 @auther Egtra
461 */
462 Static Function ReadLine() As String
463 ReadLine = in.ReadLine()
464 End Function
465
466 /*
467 @brief 標準入力から1行読み込む
468 @date 2008/02/26
469 @auther Egtra
470 */
471 Static Function Read() As Long
472 Read = in.Read()
473 End Function
474
475 /*
476 @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア
477 @date 2008/09/02
478 @auther NoWest
479 */
480 Static Sub Clear()
481 If Console.hconsoleout = NULL Then
482 Exit Sub
483 Else
484 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
485 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
486 If ret = 0 Then Throw New IO.IOException()
487 Dim length = csbi.dwSize.X * csbi.dwSize.Y
488 Dim written As DWord
489 Dim s = New String(" ")
490 ret = FillConsoleOutputCharacter(Console.hconsoleout,s[0],length,0,written)
491 If ret = 0 Then Throw New IO.IOException()
492 ret = FillConsoleOutputAttribute(Console.hconsoleout,csbi.wAttributes,length,0,written)
493 If ret = 0 Then Throw New IO.IOException()
494 ret = SetConsoleCursorPosition(Console.hconsoleout,0)
495 If ret = 0 Then Throw New IO.IOException()
496 End If
497 End Sub
498
499 /*
500 @brief 標準エラー ストリームを取得
501 @date 2008/09/07
502 @auther NoWest
503 */
504 Static Sub OpenStandardError()
505 Console.SetError(System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(New System.IO.FileStream(GetStdHandle(STD_ERROR_HANDLE), System.IO.FileAccess.Write, False))))
506 End Sub
507
508 /*
509 @brief 標準入力ストリーム ストリームを取得
510 @date 2008/09/07
511 @auther NoWest
512 */
513 Static Sub OpenStandardInput()
514 Console.SetIn(System.IO.TextReader.Synchronized(New System.IO.StreamReader(New System.IO.FileStream(GetStdHandle(STD_INPUT_HANDLE), System.IO.FileAccess.Read, False))))
515 End Sub
516
517 /*
518 @brief 標準出力ストリーム ストリームを取得
519 @date 2008/09/07
520 @auther NoWest
521 */
522 Static Sub OpenStandardOutput()
523 Console.SetOut(System.IO.TextWriter.Synchronized(New System.IO.StreamWriter(New System.IO.FileStream(GetStdHandle(STD_OUTPUT_HANDLE), System.IO.FileAccess.Write, False))))
524 Console.defBC = This.ConsoleColorToTextAttribute(Console.BackgroundColor)
525 Console.defFC = This.ConsoleColorToTextAttribute(Console.ForegroundColor)
526 End Sub
527
528 /*
529 @brief コンソールの前景色および背景色を既定値に設定
530 @date 2008/09/07
531 @auther NoWest
532 */
533 Static Sub ResetColor()
534 Console.BackgroundColor = TextAttributeToConsoleColor(Console.defBC)
535 Console.ForegroundColor = TextAttributeToConsoleColor(Console.defFC)
536 End Sub
537
538 /*
539 @brief バッファ領域の高さと幅を指定された値に設定
540 @date 2008/09/02
541 @auther NoWest
542 */
543 Static Sub SetBufferSize ( width As Long, height As Long )
544 If Console.hconsoleout = NULL Then
545 Exit Sub
546 Else
547 Dim size As COORD
548 size.X = width As Integer
549 size.Y = height As Integer
550 Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
551 If ret = 0 Then Throw New IO.IOException()
552 End If
553 End Sub
554
555 /*
556 @brief カーソルの位置を設定
557 @date 2008/09/02
558 @auther NoWest
559 */
560 Static Sub SetCursorPosition ( left As Long, top As Long )
561 If Console.hconsoleout = NULL Then
562 Exit Sub
563 Else
564 Dim pos As COORD
565 pos.X = left As Integer
566 pos.Y = top As Integer
567 Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
568 If ret = 0 Then Throw New IO.IOException()
569 End If
570 End Sub
571
572Private
573 Function enter() As ActiveBasic.Windows.CriticalSectionLock
574 Imports ActiveBasic.Windows
575 If ActiveBasic.IsNothing(cs) Then
576 Dim lock = New CriticalSectionLock(_System_CriticalSection)
577 Try
578 If ActiveBasic.IsNothing(cs) Then
579 cs = New CriticalSection
580 End If
581 Finally
582 lock.Dispose()
583 End Try
584 End If
585 enter = cs.Enter
586 End Function
587
588 Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word
589 Dim ret = value As DWord
590 Return ret As Word
591 End Function
592
593 Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor
594 Select Case value
595 Case 0
596 Return ConsoleColor.Black
597 Case FOREGROUND_INTENSITY
598 Return ConsoleColor.DarkGray
599 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
600 Return ConsoleColor.Gray
601 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
602 Return ConsoleColor.White
603 Case FOREGROUND_RED
604 Return ConsoleColor.DarkRed
605 Case FOREGROUND_RED Or FOREGROUND_INTENSITY
606 Return ConsoleColor.Red
607 Case FOREGROUND_RED Or FOREGROUND_GREEN
608 Return ConsoleColor.DarkYellow
609 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY
610 Return ConsoleColor.Yellow
611 Case FOREGROUND_GREEN
612 Return ConsoleColor.DarkGreen
613 Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY
614 Return ConsoleColor.Green
615 Case FOREGROUND_GREEN Or FOREGROUND_BLUE
616 Return ConsoleColor.DarkCyan
617 Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
618 Return ConsoleColor.Cyan
619 Case FOREGROUND_BLUE
620 Return ConsoleColor.DarkBlue
621 Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY
622 Return ConsoleColor.Blue
623 Case FOREGROUND_RED Or FOREGROUND_BLUE
624 Return ConsoleColor.DarkMagenta
625 Case FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
626 Return ConsoleColor.Magenta
627 Case Else
628 Return ConsoleColor.Gray
629 End Select
630 End Function
631
632 Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
633 If Console.hconsoleout = NULL Then
634 Exit Sub
635 Else
636 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
637 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
638 If ret = 0 Then Throw New IO.IOException()
639 left = csbi.dwCursorPosition.X
640 top = csbi.dwCursorPosition.Y
641 End If
642 End Sub
643
644 Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
645 If Console.hconsoleout = NULL Then
646 Exit Sub
647 Else
648 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
649 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
650 If ret = 0 Then Throw New IO.IOException()
651 width = csbi.dwSize.X
652 height = csbi.dwSize.Y
653 End If
654 End Sub
655
656 Static hconsoleerr = NULL As HANDLE
657 Static hconsolein = NULL As HANDLE
658 Static hconsoleout = NULL As HANDLE
659 Static in = Nothing As IO.TextReader
660 Static out = Nothing As IO.TextWriter
661 Static err = Nothing As IO.TextWriter
662 Static cs = Nothing As ActiveBasic.Windows.CriticalSection
663 Static defBC As Word
664 Static defFC As Word
665End Class
666
667End Namespace 'System
Note: See TracBrowser for help on using the repository browser.