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_GREEN Or FOREGROUND_INTENSITY
|
---|
28 | End Enum
|
---|
29 |
|
---|
30 | /*
|
---|
31 | @brief コンソール入出力・ウィンドウなどのクラス
|
---|
32 | @date 2008/02/26
|
---|
33 | @auther Egtra
|
---|
34 | */
|
---|
35 | Class Console
|
---|
36 | Public
|
---|
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 |
|
---|
527 | Private
|
---|
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_GREEN 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
|
---|
623 | End Class
|
---|
624 |
|
---|
625 | End Namespace 'System
|
---|