1 | 'Classes/System/Console.ab
|
---|
2 |
|
---|
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_BLUE Or FOREGROUND_INTENSITY
|
---|
28 | End Enum
|
---|
29 |
|
---|
30 |
|
---|
31 | /*
|
---|
32 | @brief コンソール入出力・ウィンドウなどのクラス
|
---|
33 | @date 2008/02/26
|
---|
34 | @auther Egtra
|
---|
35 | */
|
---|
36 | Class Console
|
---|
37 | Public
|
---|
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 | End Sub
|
---|
299 |
|
---|
300 | /*
|
---|
301 | @brief 標準出力を取得する
|
---|
302 | @date 2008/06/21
|
---|
303 | @auther overtaker
|
---|
304 | */
|
---|
305 | Static Function Out() As IO.TextWriter
|
---|
306 | Out = out
|
---|
307 | End Function
|
---|
308 |
|
---|
309 | /*
|
---|
310 | @brief 標準出力に1行書き込む
|
---|
311 | @date 2008/06/21
|
---|
312 | @auther overtaker
|
---|
313 | */
|
---|
314 | Static Sub WriteLine(value As String)
|
---|
315 | out.WriteLine(value)
|
---|
316 | out.Flush()
|
---|
317 | End Sub
|
---|
318 |
|
---|
319 | Static Sub WriteLine()
|
---|
320 | out.WriteLine()
|
---|
321 | out.Flush()
|
---|
322 | End Sub
|
---|
323 |
|
---|
324 | Static Sub WriteLine(x As Boolean)
|
---|
325 | WriteLine(Str$(x))
|
---|
326 | End Sub
|
---|
327 |
|
---|
328 | Static Sub WriteLine(x As Char)
|
---|
329 | WriteLine(Chr$(x))
|
---|
330 | End Sub
|
---|
331 |
|
---|
332 | Static Sub WriteLine(x As Byte)
|
---|
333 | WriteLine(Str$(x))
|
---|
334 | End Sub
|
---|
335 | #ifdef UNICODE
|
---|
336 | Static Sub WriteLine(x As SByte)
|
---|
337 | WriteLine(Str$(x))
|
---|
338 | End Sub
|
---|
339 | #else
|
---|
340 | Static Sub WriteLine(x As Word)
|
---|
341 | WriteLine(Str$(x))
|
---|
342 | End Sub
|
---|
343 | #endif
|
---|
344 | Static Sub WriteLine(x As Integer)
|
---|
345 | WriteLine(Str$(x))
|
---|
346 | End Sub
|
---|
347 |
|
---|
348 | Static Sub WriteLine(x As DWord)
|
---|
349 | WriteLine(Str$(x))
|
---|
350 | End Sub
|
---|
351 |
|
---|
352 | Static Sub WriteLine(x As Long)
|
---|
353 | WriteLine(Str$(x))
|
---|
354 | End Sub
|
---|
355 |
|
---|
356 | Static Sub WriteLine(x As QWord)
|
---|
357 | WriteLine(Str$(x))
|
---|
358 | End Sub
|
---|
359 |
|
---|
360 | Static Sub WriteLine(x As Int64)
|
---|
361 | WriteLine(Str$(x))
|
---|
362 | End Sub
|
---|
363 |
|
---|
364 | Static Sub WriteLine(x As Single)
|
---|
365 | WriteLine(Str$(x))
|
---|
366 | End Sub
|
---|
367 |
|
---|
368 | Static Sub WriteLine(x As Double)
|
---|
369 | WriteLine(Str$(x))
|
---|
370 | End Sub
|
---|
371 |
|
---|
372 | Static Sub WriteLine(x As Object)
|
---|
373 | WriteLine(x.ToString)
|
---|
374 | End Sub
|
---|
375 |
|
---|
376 | /*
|
---|
377 | @brief 標準出力に書き込む
|
---|
378 | @date 2008/06/21
|
---|
379 | @auther overtaker
|
---|
380 | */
|
---|
381 | Static Sub Write(s As String)
|
---|
382 | out.Write(s)
|
---|
383 | out.Flush()
|
---|
384 | End Sub
|
---|
385 |
|
---|
386 | Static Sub Write(x As Boolean)
|
---|
387 | Write(Str$(x))
|
---|
388 | End Sub
|
---|
389 |
|
---|
390 | Static Sub Write(x As Char)
|
---|
391 | Write(Chr$(x))
|
---|
392 | End Sub
|
---|
393 |
|
---|
394 | Static Sub Write(x As Byte)
|
---|
395 | Write(Str$(x))
|
---|
396 | End Sub
|
---|
397 | #ifdef UNICODE
|
---|
398 | Static Sub Write(x As SByte)
|
---|
399 | Write(Str$(x))
|
---|
400 | End Sub
|
---|
401 | #else
|
---|
402 | Static Sub Write(x As Word)
|
---|
403 | Write(Str$(x))
|
---|
404 | End Sub
|
---|
405 | #endif
|
---|
406 | Static Sub Write(x As Integer)
|
---|
407 | Write(Str$(x))
|
---|
408 | End Sub
|
---|
409 |
|
---|
410 | Static Sub Write(x As DWord)
|
---|
411 | Write(Str$(x))
|
---|
412 | End Sub
|
---|
413 |
|
---|
414 | Static Sub Write(x As Long)
|
---|
415 | Write(Str$(x))
|
---|
416 | End Sub
|
---|
417 |
|
---|
418 | Static Sub Write(x As QWord)
|
---|
419 | Write(Str$(x))
|
---|
420 | End Sub
|
---|
421 |
|
---|
422 | Static Sub Write(x As Int64)
|
---|
423 | Write(Str$(x))
|
---|
424 | End Sub
|
---|
425 |
|
---|
426 | Static Sub Write(x As Object)
|
---|
427 | Write(x.ToString)
|
---|
428 | End Sub
|
---|
429 |
|
---|
430 | /*
|
---|
431 | @brief 標準入力を設定する
|
---|
432 | @date 2008/02/26
|
---|
433 | @auther Egtra
|
---|
434 | */
|
---|
435 | Static Sub SetIn(newIn As IO.TextReader)
|
---|
436 | If ActiveBasic.IsNothing(newIn) Then
|
---|
437 | Throw New ArgumentNullException("newIn")
|
---|
438 | End If
|
---|
439 | Console.in = newIn
|
---|
440 | End Sub
|
---|
441 |
|
---|
442 | /*
|
---|
443 | @brief 標準入力を取得する
|
---|
444 | @date 2008/02/26
|
---|
445 | @auther Egtra
|
---|
446 | */
|
---|
447 | Static Function In() As IO.TextReader
|
---|
448 | In = in
|
---|
449 | End Function
|
---|
450 |
|
---|
451 | /*
|
---|
452 | @brief 標準入力から1行読み込む
|
---|
453 | @date 2008/02/26
|
---|
454 | @auther Egtra
|
---|
455 | */
|
---|
456 | Static Function ReadLine() As String
|
---|
457 | ReadLine = in.ReadLine()
|
---|
458 | End Function
|
---|
459 |
|
---|
460 | /*
|
---|
461 | @brief 標準入力から1行読み込む
|
---|
462 | @date 2008/02/26
|
---|
463 | @auther Egtra
|
---|
464 | */
|
---|
465 | Static Function Read() As Long
|
---|
466 | Read = in.Read()
|
---|
467 | End Function
|
---|
468 |
|
---|
469 | /*
|
---|
470 | @brief コンソール バッファおよび対応するコンソール ウィンドウをクリア
|
---|
471 | @date 2008/09/02
|
---|
472 | @auther NoWest
|
---|
473 | */
|
---|
474 | Static Sub Clear()
|
---|
475 | If Console.hconsoleout = NULL Then
|
---|
476 | Exit Sub
|
---|
477 | Else
|
---|
478 | Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
|
---|
479 | Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
|
---|
480 | If ret = 0 Then Throw New IO.IOException()
|
---|
481 | Dim length = csbi.dwSize.X * csbi.dwSize.Y
|
---|
482 | Dim written As DWord
|
---|
483 | Dim s = New String(" ")
|
---|
484 | ret = FillConsoleOutputCharacter(Console.hconsoleout,s[0],length,0,written)
|
---|
485 | If ret = 0 Then Throw New IO.IOException()
|
---|
486 | ret = FillConsoleOutputAttribute(Console.hconsoleout,csbi.wAttributes,length,0,written)
|
---|
487 | If ret = 0 Then Throw New IO.IOException()
|
---|
488 | ret = SetConsoleCursorPosition(Console.hconsoleout,0)
|
---|
489 | If ret = 0 Then Throw New IO.IOException()
|
---|
490 | End If
|
---|
491 | End Sub
|
---|
492 |
|
---|
493 | /*
|
---|
494 | @brief 標準エラー ストリームを取得
|
---|
495 | @date 2008/09/07
|
---|
496 | @auther NoWest
|
---|
497 | */
|
---|
498 | Static Sub OpenStandardError()
|
---|
499 | Dim w = New Detail.ConsoleWriter(hconsoleerr)
|
---|
500 | Console.SetOut(System.IO.TextWriter.Synchronized(w))
|
---|
501 | End Sub
|
---|
502 |
|
---|
503 | /*
|
---|
504 | @brief 標準入力ストリーム ストリームを取得
|
---|
505 | @date 2008/09/07
|
---|
506 | @auther NoWest
|
---|
507 | */
|
---|
508 | Static Sub OpenStandardInput()
|
---|
509 | Dim w = New Detail.ConsoleReader(hconsolein)
|
---|
510 | Console.SetIn(System.IO.TextReader.Synchronized(w))
|
---|
511 | End Sub
|
---|
512 |
|
---|
513 | /*
|
---|
514 | @brief 標準出力ストリーム ストリームを取得
|
---|
515 | @date 2008/09/07
|
---|
516 | @auther NoWest
|
---|
517 | */
|
---|
518 | Static Sub OpenStandardOutput()
|
---|
519 | Dim w = New Detail.ConsoleWriter(hconsoleout)
|
---|
520 | Console.SetOut(System.IO.TextWriter.Synchronized(w))
|
---|
521 | Console.defBC = This.ConsoleColorToTextAttribute(Console.BackgroundColor)
|
---|
522 | Console.defFC = This.ConsoleColorToTextAttribute(Console.ForegroundColor)
|
---|
523 | End Sub
|
---|
524 |
|
---|
525 | /*
|
---|
526 | @brief コンソールの前景色および背景色を既定値に設定
|
---|
527 | @date 2008/09/07
|
---|
528 | @auther NoWest
|
---|
529 | */
|
---|
530 | Static Sub ResetColor()
|
---|
531 | Console.BackgroundColor = TextAttributeToConsoleColor(Console.defBC)
|
---|
532 | Console.ForegroundColor = TextAttributeToConsoleColor(Console.defFC)
|
---|
533 | End Sub
|
---|
534 |
|
---|
535 | /*
|
---|
536 | @brief バッファ領域の高さと幅を指定された値に設定
|
---|
537 | @date 2008/09/02
|
---|
538 | @auther NoWest
|
---|
539 | */
|
---|
540 | Static Sub SetBufferSize ( width As Long, height As Long )
|
---|
541 | If Console.hconsoleout = NULL Then
|
---|
542 | Exit Sub
|
---|
543 | Else
|
---|
544 | Dim size As COORD
|
---|
545 | size.X = width As Integer
|
---|
546 | size.Y = height As Integer
|
---|
547 | Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
|
---|
548 | If ret = 0 Then Throw New IO.IOException()
|
---|
549 | End If
|
---|
550 | End Sub
|
---|
551 |
|
---|
552 | /*
|
---|
553 | @brief カーソルの位置を設定
|
---|
554 | @date 2008/09/02
|
---|
555 | @auther NoWest
|
---|
556 | */
|
---|
557 | Static Sub SetCursorPosition ( left As Long, top As Long )
|
---|
558 | If Console.hconsoleout = NULL Then
|
---|
559 | Exit Sub
|
---|
560 | Else
|
---|
561 | Dim pos As COORD
|
---|
562 | pos.X = left As Integer
|
---|
563 | pos.Y = top As Integer
|
---|
564 | Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
|
---|
565 | If ret = 0 Then Throw New IO.IOException()
|
---|
566 | End If
|
---|
567 | End Sub
|
---|
568 |
|
---|
569 | Private
|
---|
570 | Function enter() As ActiveBasic.Windows.CriticalSectionLock
|
---|
571 | Imports ActiveBasic.Windows
|
---|
572 | If ActiveBasic.IsNothing(cs) Then
|
---|
573 | Dim lock = New CriticalSectionLock(_System_CriticalSection)
|
---|
574 | Try
|
---|
575 | If ActiveBasic.IsNothing(cs) Then
|
---|
576 | cs = New CriticalSection
|
---|
577 | End If
|
---|
578 | Finally
|
---|
579 | lock.Dispose()
|
---|
580 | End Try
|
---|
581 | End If
|
---|
582 | enter = cs.Enter
|
---|
583 | End Function
|
---|
584 |
|
---|
585 | Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word
|
---|
586 | Dim ret = value As DWord
|
---|
587 | Return ret As Word
|
---|
588 | End Function
|
---|
589 |
|
---|
590 | Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor
|
---|
591 | Select Case value
|
---|
592 | Case 0
|
---|
593 | Return ConsoleColor.Black
|
---|
594 | Case FOREGROUND_INTENSITY
|
---|
595 | Return ConsoleColor.DarkGray
|
---|
596 | Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
|
---|
597 | Return ConsoleColor.Gray
|
---|
598 | Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
|
---|
599 | Return ConsoleColor.White
|
---|
600 | Case FOREGROUND_RED
|
---|
601 | Return ConsoleColor.DarkRed
|
---|
602 | Case FOREGROUND_RED Or FOREGROUND_INTENSITY
|
---|
603 | Return ConsoleColor.Red
|
---|
604 | Case FOREGROUND_RED Or FOREGROUND_GREEN
|
---|
605 | Return ConsoleColor.DarkYellow
|
---|
606 | Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY
|
---|
607 | Return ConsoleColor.Yellow
|
---|
608 | Case FOREGROUND_GREEN
|
---|
609 | Return ConsoleColor.DarkGreen
|
---|
610 | Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY
|
---|
611 | Return ConsoleColor.Green
|
---|
612 | Case FOREGROUND_GREEN Or FOREGROUND_BLUE
|
---|
613 | Return ConsoleColor.DarkCyan
|
---|
614 | Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
|
---|
615 | Return ConsoleColor.Cyan
|
---|
616 | Case FOREGROUND_BLUE
|
---|
617 | Return ConsoleColor.DarkBlue
|
---|
618 | Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY
|
---|
619 | Return ConsoleColor.Blue
|
---|
620 | Case FOREGROUND_RED Or FOREGROUND_BLUE
|
---|
621 | Return ConsoleColor.DarkMagenta
|
---|
622 | Case FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
|
---|
623 | Return ConsoleColor.Magenta
|
---|
624 | Case Else
|
---|
625 | Return ConsoleColor.Gray
|
---|
626 | End Select
|
---|
627 | End Function
|
---|
628 |
|
---|
629 | Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
|
---|
630 | If Console.hconsoleout = NULL Then
|
---|
631 | Exit Sub
|
---|
632 | Else
|
---|
633 | Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
|
---|
634 | Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
|
---|
635 | If ret = 0 Then Throw New IO.IOException()
|
---|
636 | left = csbi.dwCursorPosition.X
|
---|
637 | top = csbi.dwCursorPosition.Y
|
---|
638 | End If
|
---|
639 | End Sub
|
---|
640 |
|
---|
641 | Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
|
---|
642 | If Console.hconsoleout = NULL Then
|
---|
643 | Exit Sub
|
---|
644 | Else
|
---|
645 | Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
|
---|
646 | Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
|
---|
647 | If ret = 0 Then Throw New IO.IOException()
|
---|
648 | width = csbi.dwSize.X
|
---|
649 | height = csbi.dwSize.Y
|
---|
650 | End If
|
---|
651 | End Sub
|
---|
652 |
|
---|
653 | Static hconsoleerr = GetStdHandle(STD_ERROR_HANDLE) As HANDLE
|
---|
654 | Static hconsolein = GetStdHandle(STD_INPUT_HANDLE) As HANDLE
|
---|
655 | Static hconsoleout = GetStdHandle(STD_OUTPUT_HANDLE) As HANDLE
|
---|
656 | Static in = Nothing As IO.TextReader
|
---|
657 | Static out = Nothing As IO.TextWriter
|
---|
658 | Static err = Nothing As IO.TextWriter
|
---|
659 | Static cs = Nothing As ActiveBasic.Windows.CriticalSection
|
---|
660 | Static defBC As Word
|
---|
661 | Static defFC As Word
|
---|
662 | End Class
|
---|
663 |
|
---|
664 | Namespace Detail
|
---|
665 |
|
---|
666 | Class ConsoleWriter
|
---|
667 | Inherits IO.TextWriter
|
---|
668 | Public
|
---|
669 | Sub ConsoleWriter(hOut As HANDLE)
|
---|
670 | h = hOut
|
---|
671 | End Sub
|
---|
672 |
|
---|
673 | Override Sub Flush()
|
---|
674 | Dim b = Buffer
|
---|
675 | Dim written As DWord
|
---|
676 | WriteConsole(h, StrPtr(b), b.Length As DWord, written, 0)
|
---|
677 | b.Remove(0, written As Long)
|
---|
678 | End Sub
|
---|
679 |
|
---|
680 | Private
|
---|
681 | h As HANDLE
|
---|
682 | End Class
|
---|
683 |
|
---|
684 | Class ConsoleReader
|
---|
685 | Inherits IO.TextReader
|
---|
686 | Public
|
---|
687 | Sub ConsoleReader(hIn As HANDLE)
|
---|
688 | h = hIn
|
---|
689 | End Sub
|
---|
690 |
|
---|
691 | Protected
|
---|
692 | Override Function Underflow() As Boolean
|
---|
693 | Dim b = Buffer
|
---|
694 | Dim currentBufLength = b.Length
|
---|
695 | b.Length = currentBufLength + 256
|
---|
696 | Dim p = StrPtr(b)
|
---|
697 | Dim read As DWord
|
---|
698 | If ReadConsole(h, VarPtr(p[currentBufLength]), 256, read, 0) = 0 Then
|
---|
699 | IO.Detail.ThrowWinLastErrorIOException()
|
---|
700 | End If
|
---|
701 | b.Length = currentBufLength + read
|
---|
702 | End Function
|
---|
703 |
|
---|
704 | Private
|
---|
705 | h As HANDLE
|
---|
706 | End Class
|
---|
707 |
|
---|
708 | End Namespace 'Detail
|
---|
709 |
|
---|
710 | End Namespace 'System
|
---|