source: Include/basic/command.sbp@ 119

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

Unicode (#50) 前準備
Byte→Char (#51) 型名は殆ど完了、ただし中身までは手を付けていないものが多い

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