source: Include/basic/command.sbp@ 123

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

(拡張)メタファイル関数(全部)・構造体(一部)、BITMAPV4HEADERとそれに関連する型などの宣言

File size: 11.3 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 ZeroMemory(VarPtr(mii), Len(mii))
83 With mii
84 .cbSize = Len(mii)
85 .fMask = MIIM_TYPE
86
87 If lpString.Length = 0 Then
88 mii.fType = MFT_SEPARATOR
89 Else
90 .fType = MFT_STRING
91 .fMask = .fMask or MIIM_STATE or MIIM_ID
92 .dwTypeData = StrPtr(lpString)
93 .wID = id
94 If hSubMenu Then
95 .fMask = .fMask or MIIM_SUBMENU
96 .hSubMenu = hSubMenu
97 End If
98 .fState=state
99 End If
100 End With
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 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
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, ByRef buf As String, bufLen As Long)
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->ReSize(bufLen)
242 memcpy(pTempStr->Chars, buf.Chars, SizeOf (Char) * pTempStr->Length)
243 pTempStr->Chars[pTempStr->Length] = 0
244 End Select
245End Sub
246
247Sub PRINT_ToFile(FileNumber As Long, buf As String)
248 Dim dwAccessByte As DWord
249 FileNumber--
250
251 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
252End Sub
253
254Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
255Dim _System_UsingStrData[_System_MAX_PARMSNUM] As String
256Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
257Function _System_GetUsingFormat(UsingStr As String) As String
258 Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
259 Dim temporary[255] As Char
260 Dim buffer As String
261
262 buffer=ZeroString(1024)
263
264 ParmNum=0
265 i2=0
266 While 1
267 While 1
268 If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While
269 buffer[i3]=UsingStr[i2]
270 If UsingStr[i2]=0 Then Exit While
271 i2++
272 i3++
273 Wend
274
275 If UsingStr[i2]=0 Then Exit While
276
277 If UsingStr[i2]=Asc("#") Then
278 Dim dec As Long, sign As Long
279 Dim temp2 As *Char
280
281 Dim length_num As Long, length_buf As Long
282 Dim dblRoundOff=0 As Double
283
284
285 '----------------------
286 ' 四捨五入を考慮
287 '----------------------
288
289 i4=i2
290 While UsingStr[i4]=Asc("#")
291 i4++
292 Wend
293 If UsingStr[i4]=Asc(".") Then
294 i4++
295
296 dblRoundOff=0.5
297 While UsingStr[i4]=Asc("#")
298 i4++
299 dblRoundOff /= 10
300 Wend
301 End If
302
303
304 '浮動小数点を文字列に変換
305 temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign)
306
307 '整数部
308 length_num=dec
309 If length_num<=0 Then length_num=1
310
311 '符号が有る場合は、一文字分のスペースを考慮する
312 If sign Then length_num++
313
314 length_buf=0
315 Do
316 i2++
317 length_buf++
318 Loop While UsingStr[i2]=Asc("#")
319
320 If length_buf>=length_num Then
321 '通常時
322 _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ")
323
324 i3 += length_buf - length_num
325
326 If sign Then
327 buffer[i3] = Asc("-")
328 i3++
329
330 length_num--
331 End If
332
333 If dec > 0 Then
334 memcpy(VarPtr(buffer[i3]), temp2, SizeOf (Char) * length_num)
335 Else
336 buffer[i3] = &H30
337 End If
338
339 i3 += length_num
340 Else
341 '表示桁が足りないとき
342 _System_FillChar(VarPtr(buffer[i3]), length_buf,&h23) 'Asc("#")
343 i3 += length_buf
344 End If
345
346 If UsingStr[i2] = Asc(".") Then
347 buffer[i3] = UsingStr[i2]
348 i2++
349 i3++
350
351 i4=dec
352 While UsingStr[i2] = Asc("#")
353 If i4<0 Then
354 buffer[i3]=&H30
355 Else
356 buffer[i3]=temp2[i4]
357 End If
358 i3++
359 i4++
360
361 i2++
362 Wend
363 End If
364 ElseIf UsingStr[i2]=Asc("@") Then
365 i2++
366
367 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
368 memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _
369 SizeOf (Char) * lstrlen(_System_UsingStrData[ParmNum]))
370 i3 += lstrlen(_System_UsingStrData[ParmNum])
371 ElseIf UsingStr[i2]=Asc("&") Then
372 i4=0
373 Do
374 i4++
375 i2++
376 Loop While UsingStr[i2]=Asc(" ")
377
378 If UsingStr[i2]=Asc("&") Then
379 i4++
380 i2++
381 i5=lstrlen(_System_UsingStrData[ParmNum])
382 If i4<=i5 Then
383 i5=i4
384 Else
385 _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ")
386 End If
387 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5)
388 i3 += i4
389 Else
390 i2 -= i4
391 buffer[i3] = Asc("&")
392 i2++
393 i3++
394 Continue
395 End If
396 End If
397
398 ParmNum++
399 Wend
400
401 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
402End Function
403Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
404 Dim dwAccessByte As DWord
405 Dim buf As String
406
407 FileNumber--
408 buf=_System_GetUsingFormat(UsingStr)
409
410 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
411End Sub
412
413Dim _System_FieldSize(255) As Long
414Macro FIELD(FileNumber As Long, FieldSize As Long)
415 FileNumber--
416
417 _System_FieldSize(FileNumber)=FieldSize
418End Macro
419Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
420 Dim dwAccessByte As Long
421
422 FileNumber--
423 RecodeNumber--
424
425 SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)
426 lpBuffer=ZeroString(_System_FieldSize(FileNumber))
427 ReadFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)
428 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
429 lpBuffer=Left$(lpBuffer,dwAccessByte)
430 End If
431End Macro
432Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
433 Dim dwAccessByte As Long
434
435 FileNumber--
436 RecodeNumber--
437
438 SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)
439 WriteFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)
440End Macro
441
442Macro CHDIR(path As String)
443 SetCurrentDirectory(path)
444End Macro
445Macro MKDIR(path As String)
446 CreateDirectory(path, 0)
447End Macro
448Macro KILL(path As String)
449 DeleteFile(path)
450End Macro
451
452
453#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.