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

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

さらにConsoleクラスを強化しました。
また、COLOR命令、CLS命令、LOCATE命令に対応しました。
PRINT命令はStringクラスのみ対応ですが、一応BASICの命令だけで色々できるようになりました。
File size: 16.7 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(StrPtr(title))
243 End If
244 End Sub
245 Static Function Title() As String
246 Dim sb = New Text.StringBuilder(24500*SizeOf(Char))
247 If Console.hconsoleout =NULL Then
248 Return ""
249 Else
250 GetConsoleTitle(sb.__Chars(),sb.Length())
251 End If
252 End Function
253
254
255 /*
256 @brief 標準エラー出力を設定する
257 @date 2008/08/21
258 @auther Egtra
259 */
260 Static Sub SetError(newErr As IO.TextWriter)
261 If ActiveBasic.IsNothing(newErr) Then
262 Throw New ArgumentNullException("newErr")
263 End If
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()
268 End Sub
269
270 /*
271 @brief 標準エラー出力を取得する
272 @date 2008/08/21
273 @auther Egtra
274 */
275 Static Function Error() As IO.TextWriter
276 Error = err
277 End Function
278
279 /*
280 @brief 標準出力を設定する
281 @date 2008/06/21
282 @auther overtaker
283 */
284 Static Sub SetOut(newOut As IO.TextWriter)
285 If ActiveBasic.IsNothing(newOut) Then
286 Throw New ArgumentNullException("newOut")
287 End If
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()
292 End Sub
293
294 /*
295 @brief 標準出力を取得する
296 @date 2008/06/21
297 @auther overtaker
298 */
299 Static Function Out() As IO.TextWriter
300 Out = out
301 End Function
302
303 /*
304 @brief 標準出力に1行書き込む
305 @date 2008/06/21
306 @auther overtaker
307 */
308 Static Sub WriteLine(value As String)
309 out.WriteLine(value)
310 out.Flush()
311 End Sub
312
313 Static Sub WriteLine()
314 out.WriteLine()
315 out.Flush()
316 End Sub
317
318 Static Sub WriteLine(x As Boolean)
319 WriteLine(Str$(x))
320 End Sub
321
322 Static Sub WriteLine(x As Char)
323 WriteLine(Chr$(x))
324 End Sub
325
326 Static Sub WriteLine(x As Byte)
327 WriteLine(Str$(x))
328 End Sub
329#ifdef UNICODE
330 Static Sub WriteLine(x As SByte)
331 WriteLine(Str$(x))
332 End Sub
333#else
334 Static Sub WriteLine(x As Word)
335 WriteLine(Str$(x))
336 End Sub
337#endif
338 Static Sub WriteLine(x As Integer)
339 WriteLine(Str$(x))
340 End Sub
341
342 Static Sub WriteLine(x As DWord)
343 WriteLine(Str$(x))
344 End Sub
345
346 Static Sub WriteLine(x As Long)
347 WriteLine(Str$(x))
348 End Sub
349
350 Static Sub WriteLine(x As QWord)
351 WriteLine(Str$(x))
352 End Sub
353
354 Static Sub WriteLine(x As Int64)
355 WriteLine(Str$(x))
356 End Sub
357
358 Static Sub WriteLine(x As Single)
359 WriteLine(Str$(x))
360 End Sub
361
362 Static Sub WriteLine(x As Double)
363 WriteLine(Str$(x))
364 End Sub
365
366 Static Sub WriteLine(x As Object)
367 WriteLine(x.ToString)
368 End Sub
369
370 /*
371 @brief 標準出力に書き込む
372 @date 2008/06/21
373 @auther overtaker
374 */
375 Static Sub Write(s As String)
376 out.Write(s)
377 out.Flush()
378 End Sub
379
380 Static Sub Write(x As Boolean)
381 Write(Str$(x))
382 End Sub
383
384 Static Sub Write(x As Char)
385 Write(Chr$(x))
386 End Sub
387
388 Static Sub Write(x As Byte)
389 Write(Str$(x))
390 End Sub
391#ifdef UNICODE
392 Static Sub Write(x As SByte)
393 Write(Str$(x))
394 End Sub
395#else
396 Static Sub Write(x As Word)
397 Write(Str$(x))
398 End Sub
399#endif
400 Static Sub Write(x As Integer)
401 Write(Str$(x))
402 End Sub
403
404 Static Sub Write(x As DWord)
405 Write(Str$(x))
406 End Sub
407
408 Static Sub Write(x As Long)
409 Write(Str$(x))
410 End Sub
411
412 Static Sub Write(x As QWord)
413 Write(Str$(x))
414 End Sub
415
416 Static Sub Write(x As Int64)
417 Write(Str$(x))
418 End Sub
419
420 Static Sub Write(x As Object)
421 Write(x.ToString)
422 End Sub
423
424 /*
425 @brief 標準入力を設定する
426 @date 2008/02/26
427 @auther Egtra
428 */
429 Static Sub SetIn(newIn As IO.TextReader)
430 If ActiveBasic.IsNothing(newIn) Then
431 Throw New ArgumentNullException("newIn")
432 End If
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()
437 End Sub
438
439 /*
440 @brief 標準入力を取得する
441 @date 2008/02/26
442 @auther Egtra
443 */
444 Static Function In() As IO.TextReader
445 In = in
446 End Function
447
448 /*
449 @brief 標準入力から1行読み込む
450 @date 2008/02/26
451 @auther Egtra
452 */
453 Static Function ReadLine() As String
454 ReadLine = in.ReadLine()
455 End Function
456
457 /*
458 @brief 標準入力から1行読み込む
459 @date 2008/02/26
460 @auther Egtra
461 */
462 Static Function Read() As Long
463 Read = in.Read()
464 End Function
465
466 /*
467 @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア
468 @date 2008/09/02
469 @auther NoWest
470 */
471 Static Sub Clear()
472 If Console.hconsoleout = NULL Then
473 Exit Sub
474 Else
475 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
476 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
477 If ret = 0 Then Throw New IO.IOException()
478 Dim length = csbi.dwSize.X * csbi.dwSize.Y
479 Dim written As DWord
480 Dim s = New String(" ")
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)
525 End Sub
526
527 /*
528 @brief バッファ領域の高さと幅を指定された値に設定
529 @date 2008/09/02
530 @auther NoWest
531 */
532 Static Sub SetBufferSize ( width As Long, height As Long )
533 If Console.hconsoleout = NULL Then
534 Exit Sub
535 Else
536 Dim size As COORD
537 size.X = width As Integer
538 size.Y = height As Integer
539 Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
540 If ret = 0 Then Throw New IO.IOException()
541 End If
542 End Sub
543
544 /*
545 @brief カーソルの位置を設定
546 @date 2008/09/02
547 @auther NoWest
548 */
549 Static Sub SetCursorPosition ( left As Long, top As Long )
550 If Console.hconsoleout = NULL Then
551 Exit Sub
552 Else
553 Dim pos As COORD
554 pos.X = left As Integer
555 pos.Y = top As Integer
556 Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
557 If ret = 0 Then Throw New IO.IOException()
558 End If
559 End Sub
560
561Private
562 Function enter() As ActiveBasic.Windows.CriticalSectionLock
563 Imports ActiveBasic.Windows
564 If ActiveBasic.IsNothing(cs) Then
565 Dim lock = New CriticalSectionLock(_System_CriticalSection)
566 Try
567 If ActiveBasic.IsNothing(cs) Then
568 cs = New CriticalSection
569 End If
570 Finally
571 lock.Dispose()
572 End Try
573 End If
574 enter = cs.Enter
575 End Function
576
577 Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word
578 Dim ret = value As DWord
579 Return ret As Word
580 End Function
581
582 Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor
583 Select Case value
584 Case 0
585 Return ConsoleColor.Black
586 Case FOREGROUND_INTENSITY
587 Return ConsoleColor.DarkGray
588 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
589 Return ConsoleColor.Gray
590 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
591 Return ConsoleColor.White
592 Case FOREGROUND_RED
593 Return ConsoleColor.DarkRed
594 Case FOREGROUND_RED Or FOREGROUND_INTENSITY
595 Return ConsoleColor.Red
596 Case FOREGROUND_RED Or FOREGROUND_GREEN
597 Return ConsoleColor.DarkYellow
598 Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY
599 Return ConsoleColor.Yellow
600 Case FOREGROUND_GREEN
601 Return ConsoleColor.DarkGreen
602 Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY
603 Return ConsoleColor.Green
604 Case FOREGROUND_GREEN Or FOREGROUND_BLUE
605 Return ConsoleColor.DarkCyan
606 Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
607 Return ConsoleColor.Cyan
608 Case FOREGROUND_BLUE
609 Return ConsoleColor.DarkBlue
610 Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY
611 Return ConsoleColor.Blue
612 Case FOREGROUND_RED Or FOREGROUND_BLUE
613 Return ConsoleColor.DarkMagenta
614 Case FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
615 Return ConsoleColor.Magenta
616 Case Else
617 Return ConsoleColor.Gray
618 End Select
619 End Function
620
621 Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
622 If Console.hconsoleout = NULL Then
623 Exit Sub
624 Else
625 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
626 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
627 If ret = 0 Then Throw New IO.IOException()
628 left = csbi.dwCursorPosition.X
629 top = csbi.dwCursorPosition.Y
630 End If
631 End Sub
632
633 Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
634 If Console.hconsoleout = NULL Then
635 Exit Sub
636 Else
637 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
638 Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
639 If ret = 0 Then Throw New IO.IOException()
640 width = csbi.dwSize.X
641 height = csbi.dwSize.Y
642 End If
643 End Sub
644
645 Static hconsoleerr = NULL As HANDLE
646 Static hconsolein = NULL As HANDLE
647 Static hconsoleout = NULL As HANDLE
648 Static in = Nothing As IO.TextReader
649 Static out = Nothing As IO.TextWriter
650 Static err = Nothing As IO.TextWriter
651 Static cs = Nothing As ActiveBasic.Windows.CriticalSection
652End Class
653
654End Namespace 'System
Note: See TracBrowser for help on using the repository browser.