source: Include/basic/command.sbp@ 90

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

インクリメント・デクリメントなどの活用

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