source: trunk/Include/basic/command.sbp@ 465

Last change on this file since 465 was 457, checked in by イグトランス (egtra), 17 years ago

(SPrintF.ab) FormatIntegerExにStringBuilderを引数に取る版を追加。

File size: 11.6 KB
Line 
1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
7#require <windows.sbp>
8#require <Classes/System/Environment.ab>
9#require <Classes/ActiveBasic/Windows/Windows.ab>
10
11Const _System_Type_SByte = 1
12Const _System_Type_Byte = 2
13Const _System_Type_Integer = 3
14Const _System_Type_Word = 4
15Const _System_Type_Long = 5
16Const _System_Type_DWord = 6
17Const _System_Type_Int64 = 7
18Const _System_Type_QWord = 8
19Const _System_Type_Single = 9
20Const _System_Type_Double = 10
21Const _System_Type_Char = 11
22Const _System_Type_String = 13
23Const _System_Type_VoidPtr = 14
24Const _System_MAX_PARMSNUM = 32-1
25
26Dim _System_DummyStr As String
27Dim _System_DummyStr2 As String
28
29Macro BEEP()
30 MessageBeep(MB_OK)
31End Macro
32
33Sub _System_Call_Destructor_of_GlobalObject() 'dummy
34End Sub
35
36Sub _System_End()
37 System.Detail.hasShutdownStarted = True
38 Dim exitCode = System.Environment.ExitCode
39 _System_EndProgram()
40 ExitProcess(exitCode)
41End Sub
42
43Macro END()
44 _System_End()
45End Macro
46
47Macro EXEC(filePath As String)(cmdLine As String)
48 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
49End Macro
50
51Macro INPUT() 'dummy(INPUT_FromFile、INPUT_FromPromptを参照)
52End Macro
53
54Macro PRINT() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照)
55End Macro
56
57Macro RANDOMIZE()
58 srand(GetTickCount())
59End Macro
60
61Macro WRITE() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照)
62End Macro
63
64'----------------
65' ウィンドウ関連
66'----------------
67
68Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord)
69 Dim ret = ActiveBasic.Windows.Detail._System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
70 If VarPtr(retAns) Then
71 retAns = ret
72 End If
73End Macro
74
75Macro WINDOW(ByRef hwndRet As HWND, hOwner As HWND, x As Long, y As Long, width As Long, height As Long, title As String, dwStyle As DWord)(className As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord)
76 Dim hwnd = CreateWindowEx(dwExStyle, ToTCStr(className), ToTCStr(title), dwStyle, x, y, width, height, hOwner, id, GetModuleHandle(0), 0)
77 If VarPtr(hwndRet) Then
78 hwndRet = hwnd
79 End If
80End Macro
81
82Macro DELWND(hWnd As HWND)
83 DestroyWindow(hWnd)
84End Macro
85
86Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
87 Dim mii As MENUITEMINFO
88 ZeroMemory(VarPtr(mii), Len(mii))
89 With mii
90 .cbSize = Len(mii)
91 .fMask = MIIM_TYPE
92
93 If str.Length = 0 Then
94 mii.fType = MFT_SEPARATOR
95 Else
96 .fType = MFT_STRING
97 .fMask = .fMask or MIIM_STATE or MIIM_ID
98 .dwTypeData = ToTCStr(str)
99 .wID = id
100 If hSubMenu Then
101 .fMask = .fMask or MIIM_SUBMENU
102 .hSubMenu = hSubMenu
103 End If
104 .fState = state
105 End If
106 End With
107 InsertMenuItem(hMenu, PosID, flag, mii)
108End Macro
109
110
111'--------------
112' ファイル関連
113'--------------
114
115Dim _System_hFile(255) As HANDLE
116Macro OPEN(fileName As String, AccessFor As Long, FileNumber As Long)
117 Dim access As Long
118 Dim bAppend = False As Boolean
119 Dim creationDisposition As Long
120
121 FileNumber--
122
123 Select Case AccessFor
124 Case 0
125 access = GENERIC_READ or GENERIC_WRITE
126 creationDisposition = OPEN_ALWAYS
127 Case 1
128 access = GENERIC_READ
129 creationDisposition = OPEN_EXISTING
130 Case 2
131 access = GENERIC_WRITE
132 creationDisposition = CREATE_ALWAYS
133 Case 3
134 access = GENERIC_WRITE
135 creationDisposition = OPEN_ALWAYS
136 bAppend = True
137 End Select
138
139 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
140
141 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
142End Macro
143
144Macro CLOSE()(FileNumber As Long)
145 FileNumber--
146
147 If _System_hFile(FileNumber) Then
148 CloseHandle(_System_hFile(FileNumber))
149 _System_hFile(FileNumber)=0
150 End If
151End Macro
152
153'INPUT Command Data
154Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
155Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
156Sub INPUT_FromFile(FileNumber As Long)
157 FileNumber--
158
159 Dim i = 0 As Long
160 Dim buffer = New System.Text.StringBuilder(256)
161 Dim temp[1] As StrChar
162 Dim dwAccessBytes As DWord
163 Dim IsStr As Long
164
165 While 1
166 '次のデータをサーチ
167 Do
168 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
169 If ret=0 or dwAccessBytes=0 Then
170 'error
171 Exit Macro
172 End If
173 Loop While temp[0]=32 or temp[0]=9
174 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
175
176 '読み込み
177 IsStr=0
178 While 1
179 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
180 If ret = 0 or dwAccessBytes = 0 Then
181 'error
182 Exit Macro
183 End If
184 If temp[0]=34 Then IsStr=IsStr xor 1
185
186 buffer.Append(temp[0])
187 If dwAccessBytes=0 or temp[0]=0 or temp[0]=13 or temp[0]=10 or (IsStr=0 and temp[0]=Asc(",")) or (IsStr=0 and (temp[0]=32 or temp[0]=9) and _System_InputDataType[i]<>_System_Type_String) Then
188 If temp[0]=13 Then
189 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
190 If Not(dwAccessBytes<>0 And temp[0]=10) Then
191 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
192 Continue
193 End If
194 End If
195
196 If temp[0]=32 or temp[0]=9 Then
197 While 1
198 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
199 If dwAccessBytes=0 Then Exit While
200 If temp[0]=Asc(",") Then Exit While
201 If Not(temp[0]=32 or temp[0]=9) Then
202 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
203 Exit While
204 End If
205 Wend
206 End If
207
208 buffer.Append(0 As StrChar)
209 Exit While
210 End If
211 Wend
212
213 'データを変数に格納
214 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
215
216
217 i++
218 If _System_InputDataPtr[i]=0 Then Exit While
219 Wend
220End Sub
221
222Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
223 Select Case dataType
224 Case _System_Type_Double
225 SetDouble(arg, Val(buf))
226 Case _System_Type_Single
227 SetSingle(arg, Val(buf))
228 Case _System_Type_Int64,_System_Type_QWord
229 SetQWord(arg, Val(buf))
230 Case _System_Type_Long,_System_Type_DWord
231 SetDWord(arg, Val(buf))
232 Case _System_Type_Integer,_System_Type_Word
233 SetWord(arg, Val(buf))
234 Case _System_Type_SByte,_System_Type_Byte
235 SetByte(arg, Val(buf))
236 Case _System_Type_Char
237 SetChar(arg, buf[0])
238 Case _System_Type_String
239 Dim pTempStr As *String
240 pTempStr = arg As *String
241 pTempStr[0] = buf
242 End Select
243End Sub
244
245Sub PRINT_ToFile(FileNumber As Long, buf As String)
246 Dim dwAccessByte As DWord
247 FileNumber--
248
249 WriteFile(_System_hFile(FileNumber), StrPtr(buf), Len(buf), VarPtr(dwAccessByte), ByVal 0)
250End Sub
251
252Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
253Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認)
254Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
255/*
256Function _System_GetUsingFormat(UsingStr As String) As String
257 Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
258 Dim temporary[255] As StrChar
259 Dim buffer = New System.Text.StringBuilder(1024)
260
261 ParmNum = 0
262 i2 = 0
263 While 1
264 While 1
265 If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While
266 buffer[i3]=UsingStr[i2]
267 If UsingStr[i2]=0 Then Exit While
268 i2++
269 i3++
270 Wend
271
272 If UsingStr[i2]=0 Then Exit While
273
274 If UsingStr[i2]=Asc("#") Then
275 Dim dec As Long, sign As Long
276 Dim temp2 As *StrChar
277
278 Dim length_num As Long, length_buf As Long
279 Dim dblRoundOff=0 As Double
280
281
282 '----------------------
283 ' 四捨五入を考慮
284 '----------------------
285
286 i4=i2
287 While UsingStr[i4]=Asc("#")
288 i4++
289 Wend
290 If UsingStr[i4]=Asc(".") Then
291 i4++
292
293 dblRoundOff=0.5
294 While UsingStr[i4]=Asc("#")
295 i4++
296 dblRoundOff /= 10
297 Wend
298 End If
299
300
301 '浮動小数点を文字列に変換
302 temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign)
303
304 '整数部
305 length_num=dec
306 If length_num<=0 Then length_num=1
307
308 '符号が有る場合は、一文字分のスペースを考慮する
309 If sign Then length_num++
310
311 length_buf=0
312 Do
313 i2++
314 length_buf++
315 Loop While UsingStr[i2]=Asc("#")
316
317 If length_buf>=length_num Then
318 '通常時
319 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
320
321 i3 += length_buf - length_num
322
323 If sign Then
324 buffer[i3] = Asc("-")
325 i3++
326
327 length_num--
328 End If
329
330 If dec > 0 Then
331 memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (StrChar) * length_num)
332 Else
333 buffer[i3] = &H30
334 End If
335
336 i3 += length_num
337 Else
338 '表示桁が足りないとき
339 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
340 i3 += length_buf
341 End If
342
343 If UsingStr[i2] = Asc(".") Then
344 buffer[i3] = UsingStr[i2]
345 i2++
346 i3++
347
348 i4=dec
349 While UsingStr[i2] = Asc("#")
350 If i4<0 Then
351 buffer[i3]=&H30
352 Else
353 buffer[i3]=temp2[i4]
354 End If
355 i3++
356 i4++
357
358 i2++
359 Wend
360 End If
361 ElseIf UsingStr[i2]=Asc("@") Then
362 i2++
363
364 lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
365 i3 += lstrlen(_System_UsingStrData[ParmNum])
366 ElseIf UsingStr[i2]=Asc("&") Then
367 i4=0
368 Do
369 i4++
370 i2++
371 Loop While UsingStr[i2]=Asc(" ")
372
373 If UsingStr[i2]=Asc("&") Then
374 i4++
375 i2++
376 i5=lstrlen(_System_UsingStrData[ParmNum])
377 If i4<=i5 Then
378 i5=i4
379 Else
380 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
381 End If
382 memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
383 i3 += i4
384 Else
385 i2 -= i4
386 buffer[i3] = Asc("&")
387 i2++
388 i3++
389 Continue
390 End If
391 End If
392
393 ParmNum++
394 Wend
395
396 _System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
397End Function
398
399' TODO: _System_GetUsingFormatを用意して実装する
400Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
401 Dim dwAccessByte As DWord
402 Dim buf As String
403
404 FileNumber--
405 buf=_System_GetUsingFormat(UsingStr)
406
407 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
408End Sub
409*/
410
411Dim _System_FieldSize(255) As Long
412Macro FIELD(FileNumber As Long, FieldSize As Long)
413 FileNumber--
414 _System_FieldSize(FileNumber)=FieldSize
415End Macro
416Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef buffer As String)
417 Dim dwAccessByte As DWord
418
419 FileNumber--
420 RecodeNumber--
421
422 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
423 Dim t = ZeroString(_System_FieldSize(FileNumber))
424 ReadFile(_System_hFile(FileNumber), StrPtr(t), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
425 If dwAccessByte = _System_FieldSize(FileNumber) Then
426 buffer = t.ToString
427 Else
428 buffer = Left$(t.ToString, dwAccessByte)
429 End If
430End Macro
431Macro PUT(FileNumber As Long, RecodeNumber As Long, buffer As String)
432 Dim dwAccessByte As DWord
433
434 FileNumber--
435 RecodeNumber--
436
437 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
438 WriteFile(_System_hFile(FileNumber), StrPtr(buffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
439End Macro
440
441Macro CHDIR(path As String)
442 SetCurrentDirectory(ToTCStr(path))
443End Macro
444Macro MKDIR(path As String)
445 CreateDirectory(ToTCStr(path), 0)
446End Macro
447Macro KILL(path As String)
448 DeleteFile(ToTCStr(path))
449End Macro
450
451
452#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.