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

Last change on this file since 629 was 629, checked in by イグトランス (egtra), 16 years ago

Console.Title（取得側）が正しく動かないバグを除去
File size: 17.0 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_SUCSESS 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 End Sub
525
526 /*
527 @brief コンソールの前景色および背景色を既定値に設定(前景色=gray 背景色=black)
528 @date 2008/09/07
529 @auther NoWest
530 */
531 Static Sub ResetColor()
532 Console.BackgroundColor(ConsoleColor.Black)
533 Console.ForegroundColor(ConsoleColor.Gray)
534 End Sub
535
536 /*
537 @brief バッファ領域の高さと幅を指定された値に設定
538 @date 2008/09/02
539 @auther NoWest
540 */
541 Static Sub SetBufferSize ( width As Long, height As Long )
542 If Console.hconsoleout = NULL Then
543 Exit Sub
544 Else
545 Dim size As COORD
546 size.X = width As Integer
547 size.Y = height As Integer
548 Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
549 If ret = 0 Then Throw New IO.IOException()
550 End If
551 End Sub
552
553 /*
554 @brief カーソルの位置を設定
555 @date 2008/09/02
556 @auther NoWest
557 */
558 Static Sub SetCursorPosition ( left As Long, top As Long )
559 If Console.hconsoleout = NULL Then
560 Exit Sub
561 Else
562 Dim pos As COORD
563 pos.X = left As Integer
564 pos.Y = top As Integer
565 Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
566 If ret = 0 Then Throw New IO.IOException()
567 End If
568 End Sub
569
570Private
571 Function enter() As ActiveBasic.Windows.CriticalSectionLock
572 Imports ActiveBasic.Windows
573 If ActiveBasic.IsNothing(cs) Then
574 Dim lock = New CriticalSectionLock(_System_CriticalSection)
575 Try
576 If ActiveBasic.IsNothing(cs) Then
577 cs = New CriticalSection
578 End If
579 Finally
580 lock.Dispose()
581 End Try
582 End If
583 enter = cs.Enter
584 End Function
585
586 Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word
587 Dim ret = value As DWord
588 Return ret As Word
589 End Function
590
591 Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor
592 Select Case value
593 Case 0
594 Return ConsoleColor.Black
595 Case FOREGROUND_INTENSITY
596 Return ConsoleColor.DarkGray
597 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
598 Return ConsoleColor.Gray
599 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
600 Return ConsoleColor.White
601 Case FOREGROUND_RED
602 Return ConsoleColor.DarkRed
603 Case FOREGROUND_RED Or FOREGROUND_INTENSITY
604 Return ConsoleColor.Red
605 Case FOREGROUND_RED Or FOREGROUND_GREEN
606 Return ConsoleColor.DarkYellow
607 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY
608 Return ConsoleColor.Yellow
609 Case FOREGROUND_GREEN
610 Return ConsoleColor.DarkGreen
611 Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY
612 Return ConsoleColor.Green
613 Case FOREGROUND_GREEN Or FOREGROUND_BLUE
614 Return ConsoleColor.DarkCyan
615 Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
616 Return ConsoleColor.Cyan
617 Case FOREGROUND_BLUE
618 Return ConsoleColor.DarkBlue
619 Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY
620 Return ConsoleColor.Blue
621 Case FOREGROUND_RED Or FOREGROUND_BLUE
622 Return ConsoleColor.DarkMagenta
623 Case FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
624 Return ConsoleColor.Magenta
625 Case Else
626 Return ConsoleColor.Gray
627 End Select
628 End Function
629
630 Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
631 If Console.hconsoleout = NULL Then
632 Exit Sub
633 Else
634 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
635 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
636 If ret = 0 Then Throw New IO.IOException()
637 left = csbi.dwCursorPosition.X
638 top = csbi.dwCursorPosition.Y
639 End If
640 End Sub
641
642 Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
643 If Console.hconsoleout = NULL Then
644 Exit Sub
645 Else
646 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
647 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
648 If ret = 0 Then Throw New IO.IOException()
649 width = csbi.dwSize.X
650 height = csbi.dwSize.Y
651 End If
652 End Sub
653
654 Static hconsoleerr = NULL As HANDLE
655 Static hconsolein = NULL As HANDLE
656 Static hconsoleout = NULL As HANDLE
657 Static in = Nothing As IO.TextReader
658 Static out = Nothing As IO.TextWriter
659 Static err = Nothing As IO.TextWriter
660 Static cs = Nothing As ActiveBasic.Windows.CriticalSection
661End Class
662
663End Namespace 'System
Note: See TracBrowser for help on using the repository browser.