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

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

ミスを修正
File size: 15.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@brief コンソール入出力・ウィンドウなどのクラス
32@date 2008/02/26
33@auther Egtra
34*/
35Class Console
36Public
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 /*
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 err = newErr
274 End Sub
275
276 /*
277 @brief 標準エラー出力を取得する
278 @date 2008/08/21
279 @auther Egtra
280 */
281 Static Function Error() As IO.TextWriter
282 Error = err
283 End Function
284
285 /*
286 @brief 標準出力を設定する
287 @date 2008/06/21
288 @auther overtaker
289 */
290 Static Sub SetOut(newOut As IO.TextWriter)
291 If ActiveBasic.IsNothing(newOut) Then
292 Throw New ArgumentNullException("newOut")
293 End If
294 out = newOut
295 End Sub
296
297 /*
298 @brief 標準出力を取得する
299 @date 2008/06/21
300 @auther overtaker
301 */
302 Static Function Out() As IO.TextWriter
303 Out = out
304 End Function
305
306 /*
307 @brief 標準出力に1行書き込む
308 @date 2008/06/21
309 @auther overtaker
310 */
311 Static Sub WriteLine(value As String)
312 out.WriteLine(value)
313 out.Flush()
314 End Sub
315
316 Static Sub WriteLine()
317 out.WriteLine()
318 out.Flush()
319 End Sub
320
321 Static Sub WriteLine(x As Boolean)
322 WriteLine(Str$(x))
323 End Sub
324
325 Static Sub WriteLine(x As Char)
326 WriteLine(Chr$(x))
327 End Sub
328
329 Static Sub WriteLine(x As Byte)
330 WriteLine(Str$(x))
331 End Sub
332#ifdef UNICODE
333 Static Sub WriteLine(x As SByte)
334 WriteLine(Str$(x))
335 End Sub
336#else
337 Static Sub WriteLine(x As Word)
338 WriteLine(Str$(x))
339 End Sub
340#endif
341 Static Sub WriteLine(x As Integer)
342 WriteLine(Str$(x))
343 End Sub
344
345 Static Sub WriteLine(x As DWord)
346 WriteLine(Str$(x))
347 End Sub
348
349 Static Sub WriteLine(x As Long)
350 WriteLine(Str$(x))
351 End Sub
352
353 Static Sub WriteLine(x As QWord)
354 WriteLine(Str$(x))
355 End Sub
356
357 Static Sub WriteLine(x As Int64)
358 WriteLine(Str$(x))
359 End Sub
360
361 Static Sub WriteLine(x As Single)
362 WriteLine(Str$(x))
363 End Sub
364
365 Static Sub WriteLine(x As Double)
366 WriteLine(Str$(x))
367 End Sub
368
369 Static Sub WriteLine(x As Object)
370 WriteLine(x.ToString)
371 End Sub
372
373 /*
374 @brief 標準出力に書き込む
375 @date 2008/06/21
376 @auther overtaker
377 */
378 Static Sub Write(s As String)
379 out.Write(s)
380 out.Flush()
381 End Sub
382
383 Static Sub Write(x As Boolean)
384 Write(Str$(x))
385 End Sub
386
387 Static Sub Write(x As Char)
388 Write(Chr$(x))
389 End Sub
390
391 Static Sub Write(x As Byte)
392 Write(Str$(x))
393 End Sub
394#ifdef UNICODE
395 Static Sub Write(x As SByte)
396 Write(Str$(x))
397 End Sub
398#else
399 Static Sub Write(x As Word)
400 Write(Str$(x))
401 End Sub
402#endif
403 Static Sub Write(x As Integer)
404 Write(Str$(x))
405 End Sub
406
407 Static Sub Write(x As DWord)
408 Write(Str$(x))
409 End Sub
410
411 Static Sub Write(x As Long)
412 Write(Str$(x))
413 End Sub
414
415 Static Sub Write(x As QWord)
416 Write(Str$(x))
417 End Sub
418
419 Static Sub Write(x As Int64)
420 Write(Str$(x))
421 End Sub
422
423 Static Sub Write(x As Object)
424 Write(x.ToString)
425 End Sub
426
427 /*
428 @brief 標準入力を設定する
429 @date 2008/02/26
430 @auther Egtra
431 */
432 Static Sub SetIn(newIn As IO.TextReader)
433 If ActiveBasic.IsNothing(newIn) Then
434 Throw New ArgumentNullException("newIn")
435 End If
436 in = newIn
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 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
526
527Private
528 Function enter() As ActiveBasic.Windows.CriticalSectionLock
529 Imports ActiveBasic.Windows
530 If ActiveBasic.IsNothing(cs) Then
531 Dim lock = New CriticalSectionLock(_System_CriticalSection)
532 Try
533 If ActiveBasic.IsNothing(cs) Then
534 cs = New CriticalSection
535 End If
536 Finally
537 lock.Dispose()
538 End Try
539 End If
540 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()
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_BLUE 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
619 Static in = Nothing As IO.TextReader
620 Static out = Nothing As IO.TextWriter
621 Static err = Nothing As IO.TextWriter
622 Static cs = Nothing As ActiveBasic.Windows.CriticalSection
623End Class
624
625End Namespace 'System
Note: See TracBrowser for help on using the repository browser.