1 | 'dos_console.sbp
|
---|
2 | 'このファイルには、コンソール アプリケーション用のサポート プログラムが記載されます。
|
---|
3 |
|
---|
4 |
|
---|
5 | #ifndef _INC_DOS_CONSOLE
|
---|
6 | #define _INC_DOS_CONSOLE
|
---|
7 |
|
---|
8 |
|
---|
9 | #include <api_console.sbp>
|
---|
10 | #include <Classes/ActiveBasic/Strings/Strings.ab>
|
---|
11 |
|
---|
12 | Dim _System_hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
|
---|
13 | Dim _System_hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
|
---|
14 |
|
---|
15 | '---------- command.sbp内で定義済み ----------
|
---|
16 | 'Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
|
---|
17 | 'Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
|
---|
18 | '---------------------------------------------
|
---|
19 | Sub INPUT_FromPrompt(ShowStr As String)
|
---|
20 | Dim InputBuf[1023] As TCHAR
|
---|
21 | Dim dwAccessBytes As DWord
|
---|
22 |
|
---|
23 | *InputReStart
|
---|
24 |
|
---|
25 | PRINT_ToPrompt(ShowStr)
|
---|
26 |
|
---|
27 | '入力
|
---|
28 | ReadConsole(_System_hConsoleIn, InputBuf, Len(InputBuf), dwAccessBytes, 0)
|
---|
29 | If InputBuf[dwAccessBytes-2] = &h0d And InputBuf[dwAccessBytes-1] = &h0a Then
|
---|
30 | InputBuf[dwAccessBytes-2] = 0
|
---|
31 | dwAccessBytes -= 2
|
---|
32 | End If
|
---|
33 |
|
---|
34 | If dwAccessBytes = 0 Then Goto *InputReStart
|
---|
35 |
|
---|
36 | 'データを変数に格納
|
---|
37 | Const comma = &h2c As StrChar 'Asc(",")
|
---|
38 | Dim broken = ActiveBasic.Strings.Detail.Split(New String(InputBuf, dwAccessBytes As Long), comma)
|
---|
39 | Dim i As Long
|
---|
40 | For i = 0 To ELM(broken.Count)
|
---|
41 | If _System_InputDataPtr[i] = 0 Then
|
---|
42 | PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
|
---|
43 | Goto *InputReStart
|
---|
44 | End If
|
---|
45 | _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i].ToString)
|
---|
46 | Next
|
---|
47 |
|
---|
48 | If _System_InputDataPtr[i]<>0 Then
|
---|
49 | PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
|
---|
50 | Goto *InputReStart
|
---|
51 | End If
|
---|
52 | End Sub
|
---|
53 |
|
---|
54 | Macro LOCATE(x As Long, y As Long)
|
---|
55 | SetConsoleCursorPosition(_System_hConsoleOut, MAKELONG(x, y))
|
---|
56 | End Macro
|
---|
57 |
|
---|
58 | Sub PRINT_ToPrompt(buf As String)
|
---|
59 | Dim dwAccessBytes As DWord
|
---|
60 | #ifdef __STRING_UNICODE_WINDOWS_ANSI
|
---|
61 | ' Debug
|
---|
62 | Dim oldAlloc = _System_AllocForConvertedString
|
---|
63 | _System_AllocForConvertedString = AddressOf (_System_malloc)
|
---|
64 | Dim pszOut As PCSTR
|
---|
65 | Dim len = GetStr(buf, pszOut)
|
---|
66 | _System_AllocForConvertedString = oldAlloc
|
---|
67 | WriteConsole(_System_hConsoleOut, pszOut, len, dwAccessBytes, 0)
|
---|
68 | _System_free(pszOut)
|
---|
69 | #else
|
---|
70 | WriteConsole(_System_hConsoleOut, buf.StrPtr, buf.Length, dwAccessBytes, 0)
|
---|
71 | #endif
|
---|
72 | End Sub
|
---|
73 |
|
---|
74 | Sub PRINTUSING_ToPrompt(UsingStr As String)
|
---|
75 | PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
|
---|
76 | End Sub
|
---|
77 |
|
---|
78 |
|
---|
79 | #endif '_INC_DOS_CONSOLE
|
---|