Changeset 121 for Include/basic/prompt.sbp
- Timestamp:
- Feb 25, 2007, 12:56:09 AM (18 years ago)
- File:
-
- 1 edited
-
Include/basic/prompt.sbp (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Include/basic/prompt.sbp
r119 r121 13 13 14 14 'text 15 Dim _PromptSys_LogFont As LOGFONT 15 Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT 16 16 Dim _PromptSys_hFont As HFONT 17 17 Dim _PromptSys_FontSize As SIZE … … 21 21 Dim _PromptSys_CurPos As POINTAPI 22 22 Dim _PromptSys_Buffer[100] As *Char 23 Dim _PromptSys_TextColor[100] As DWordPtr24 Dim _PromptSys_BackColor[100] As DWordPtr25 Dim _PromptSys_NowTextColor As DWord26 Dim _PromptSys_NowBackColor As DWord23 Dim _PromptSys_TextColor[100] As *COLORREF 24 Dim _PromptSys_BackColor[100] As *COLORREF 25 Dim _PromptSys_NowTextColor As COLORREF 26 Dim _PromptSys_NowBackColor As COLORREF 27 27 Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION 28 28 … … 38 38 39 39 _PromptSys_bInitFinish=0 40 CreateThread( 40 CreateThread( _ 41 41 0, 42 42 0, … … 51 51 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long) 52 52 Dim i As Long, i2 As Long, i3 As Long 53 Dim hOldFont As HFONT54 53 Dim sz As SIZE 55 54 Dim temporary[2] As Char 56 55 57 hOldFont=SelectObject(hDC,_PromptSys_hFont)56 Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT 58 57 59 58 'Scroll 60 59 Dim rc As RECT 61 GetClientRect(_PromptSys_hWnd, rc)60 GetClientRect(_PromptSys_hWnd, rc) 62 61 While (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy>rc.bottom and _PromptSys_CurPos.y>0 63 HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[0])64 HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[0])65 HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[0])62 _System_free(_PromptSys_Buffer[0]) 63 _System_free(_PromptSys_TextColor[0]) 64 _System_free(_PromptSys_BackColor[0]) 66 65 For i=0 To 100-1 67 _PromptSys_Buffer[i] =_PromptSys_Buffer[i+1]68 _PromptSys_TextColor[i] =_PromptSys_TextColor[i+1]69 _PromptSys_BackColor[i] =_PromptSys_BackColor[i+1]66 _PromptSys_Buffer[i] = _PromptSys_Buffer[i+1] 67 _PromptSys_TextColor[i] = _PromptSys_TextColor[i+1] 68 _PromptSys_BackColor[i] = _PromptSys_BackColor[i+1] 70 69 Next 71 _PromptSys_Buffer[100] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)72 _PromptSys_TextColor[100] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))73 _PromptSys_BackColor[100] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))70 _PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255) 71 _PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255) 72 _PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255) 74 73 75 74 _PromptSys_CurPos.y-- … … 82 81 While i*_PromptSys_FontSize.cy<rc.bottom and i<=100 83 82 If StartLine=-1 or (StartLine<=i and i<=EndLine) Then 84 GetTextExtentPoint32(hDC,_PromptSys_Buffer[i],lstrlen(_PromptSys_Buffer[i]),sz) 83 i3 = lstrlen(_PromptSys_Buffer[i]) 84 GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz) 85 85 86 BitBlt(hDC,_ 86 87 sz.cx, i*_PromptSys_FontSize.cy, _ … … 88 89 _PromptSys_hMemDC,sz.cx,i*_PromptSys_FontSize.cy,SRCCOPY) 89 90 90 i3=lstrlen(_PromptSys_Buffer[i]) 91 For i2=0 To i3-1 92 SetTextColor(hDC,_PromptSys_TextColor[i][i2]) 93 If _PromptSys_BackColor[i][i2]=-1 Then 94 SetBkMode(hDC,TRANSPARENT) 91 For i2 = 0 To i3-1 92 SetTextColor(hDC, _PromptSys_TextColor[i][i2]) 93 If _PromptSys_BackColor[i][i2] = -1 Then 94 SetBkMode(hDC, TRANSPARENT) 95 95 Else 96 SetBkMode(hDC, OPAQUE)97 SetBkColor(hDC, _PromptSys_BackColor[i][i2])96 SetBkMode(hDC, OPAQUE) 97 SetBkColor(hDC, _PromptSys_BackColor[i][i2]) 98 98 End If 99 99 100 Dim tempLen As Long 100 101 temporary[0]=_PromptSys_Buffer[i][i2] 101 102 #ifdef UNICODE … … 104 105 If IsDBCSLeadByte(temporary[0]) Then 105 106 #endif 106 temporary[1] =_PromptSys_Buffer[i][i2+1]107 temporary[2] =0107 temporary[1] = _PromptSys_Buffer[i][i2+1] 108 temporary[2] = 0 108 109 i2++ 110 tempLen = 2 109 111 Else 110 temporary[1]=0 112 temporary[1] = 0 113 tempLen = 1 111 114 End If 112 TextOut(hDC,i2*_PromptSys_FontSize.cx,i*_PromptSys_FontSize.cy,_ 113 temporary,lstrlen(temporary)) 115 With _PromptSys_FontSize 116 TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen) 117 End With 114 118 Next 115 119 End If … … 118 122 Wend 119 123 120 SelectObject(hDC, hOldFont)124 SelectObject(hDC, hOldFont) 121 125 End Sub 122 126 123 127 Sub PRINT_ToPrompt(buf As String) 124 128 EnterCriticalSection(_PromptSys_SectionOfBufferAccess) 125 126 Dim hDC As HDC 129 With _PromptSys_CurPos 127 130 Dim StartLine As Long 128 Dim i2 As Long, i3 As Long 129 130 StartLine=_PromptSys_CurPos.y 131 131 StartLine = .y 132 132 'Addition 133 i2=0133 Dim i2 = 0 As Long, i3 As Long 134 134 Do 135 If buf[i2]=9 Then 'tab 136 i3=8-(_PromptSys_CurPos.x mod 8) 137 138 FillMemory(_PromptSys_Buffer[_PromptSys_CurPos.y]+_PromptSys_CurPos.x,i3,Asc(" ")) 139 135 If buf[i2] = 9 Then 'tab 136 i3 = 8 - (.x And 7) '(.x mod 8) 137 Dim j As Long 138 Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char 139 ' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" ")) 140 For j = 0 To ELM(i3) 141 p[j] = &h20 'Asc(" ") 142 Next 140 143 i2++ 141 _PromptSys_CurPos.x += i3144 .x += i3 142 145 Continue 143 146 End If 144 147 145 If buf[i2] =13 and buf[i2+1]=10 Then '\r\n148 If buf[i2] = 13 and buf[i2+1] = 10 Then '\r\n 146 149 i2 += 2 147 _PromptSys_CurPos.y++148 _PromptSys_CurPos.x=0150 .y++ 151 .x = 0 149 152 Continue 150 153 End If 151 154 152 If buf[i2] =0 Then Exit Do153 _PromptSys_Buffer[ _PromptSys_CurPos.y][_PromptSys_CurPos.x]=buf[i2]154 _PromptSys_TextColor[ _PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowTextColor155 _PromptSys_BackColor[ _PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowBackColor155 If buf[i2] = 0 Then Exit Do 156 _PromptSys_Buffer[.y][.x] = buf[i2] 157 _PromptSys_TextColor[.y][.x] = _PromptSys_NowTextColor 158 _PromptSys_BackColor[.y][.x] = _PromptSys_NowBackColor 156 159 157 160 i2++ 158 _PromptSys_CurPos.x++161 .x++ 159 162 Loop 160 161 163 'Draw the text buffer added 162 hDC=GetDC(_PromptSys_hWnd)163 DrawPromptBuffer(hDC, StartLine,_PromptSys_CurPos.y)164 ReleaseDC(_PromptSys_hWnd, hDC)165 164 Dim hDC = GetDC(_PromptSys_hWnd) 165 DrawPromptBuffer(hDC, StartLine, .y) 166 ReleaseDC(_PromptSys_hWnd, hDC) 167 End With 166 168 LeaveCriticalSection(_PromptSys_SectionOfBufferAccess) 167 169 End Sub … … 172 174 Dim ps As PAINTSTRUCT 173 175 Dim TempStr As String 174 Dim temporary[255] As Byte175 176 Dim CompForm As COMPOSITIONFORM 176 Dim hGlobal As HGLOBAL177 177 178 178 Select Case message 179 179 Case WM_CREATE 180 hDC=GetDC(hWnd) 181 _PromptSys_hBitmap=CreateCompatibleBitmap(hDC,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy) 182 _PromptSys_hMemDC=CreateCompatibleDC(hDC) 183 SelectObject(_PromptSys_hMemDC,_PromptSys_hBitmap) 180 hDC = GetDC(hWnd) 181 With _PromptSys_ScreenSize 182 _PromptSys_hBitmap = CreateCompatibleBitmap(hDC, .cx, .cy) 183 End With 184 _PromptSys_hMemDC = CreateCompatibleDC(hDC) 185 SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap) 184 186 185 187 'Initialize for Win9x 186 Dim hOldBrush As HBRUSH187 hOldBrush=SelectObject(_PromptSys_hMemDC,GetStockObject(BLACK_BRUSH))188 PatBlt(_PromptSys_hMemDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,PATCOPY)189 SelectObject(_PromptSys_hMemDC,hOldBrush)190 191 Dim hOldFont As HFONT 188 Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH 189 With _PromptSys_ScreenSize 190 PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY) 191 End With 192 SelectObject(_PromptSys_hMemDC, hOldBrush) 193 192 194 Dim tm As TEXTMETRIC 193 hOldFont=SelectObject(_PromptSys_hMemDC,_PromptSys_hFont)194 GetTextExtentPoint32(_PromptSys_hMemDC, " ",1,_PromptSys_FontSize)195 GetTextMetrics(_PromptSys_hMemDC, tm)196 SelectObject(_PromptSys_hMemDC, hOldFont)197 _PromptSys_FontSize.cy =tm.tmHeight195 Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT 196 GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize) 197 GetTextMetrics(_PromptSys_hMemDC, tm) 198 SelectObject(_PromptSys_hMemDC, hOldFont) 199 _PromptSys_FontSize.cy = tm.tmHeight 198 200 199 201 ReleaseDC(hWnd,hDC) 200 202 Case WM_PAINT 201 hDC=BeginPaint(hWnd,ps) 202 BitBlt(hDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,_PromptSys_hMemDC,0,0,SRCCOPY) 203 DrawPromptBuffer(hDC,-1,0) 204 EndPaint(hWnd,ps) 205 206 _PromptSys_bInitFinish=1 203 hDC = BeginPaint(hWnd,ps) 204 With _PromptSys_ScreenSize 205 BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY) 206 End With 207 DrawPromptBuffer(hDC, -1, 0) 208 EndPaint(hWnd, ps) 209 210 _PromptSys_bInitFinish = TRUE 207 211 Case WM_SETFOCUS 208 212 If _PromptSys_InputLen<>-1 Then 209 hIMC =ImmGetContext(hWnd)213 hIMC = ImmGetContext(hWnd) 210 214 If hIMC Then 211 CompForm.dwStyle=CFS_POINT 212 CompForm.ptCurrentPos.x=_PromptSys_CurPos.x*_PromptSys_FontSize.cx 213 CompForm.ptCurrentPos.y=_PromptSys_CurPos.y*_PromptSys_FontSize.cy 214 ImmSetCompositionWindow(hIMC,CompForm) 215 ImmSetCompositionFont(hIMC,_PromptSys_LogFont) 215 With CompForm 216 .dwStyle = CFS_POINT 217 .ptCurrentPos.x = _PromptSys_CurPos.x*_PromptSys_FontSize.cx 218 .ptCurrentPos.y = _PromptSys_CurPos.y*_PromptSys_FontSize.cy 219 End With 220 ImmSetCompositionWindow(hIMC, CompForm) 221 ImmSetCompositionFontA(hIMC, _PromptSys_LogFont) 216 222 End If 217 ImmReleaseContext(hWnd, hIMC)223 ImmReleaseContext(hWnd, hIMC) 218 224 219 225 CreateCaret(hWnd,NULL,9,6) … … 230 236 End If 231 237 Case WM_CHAR 232 If _PromptSys_InputLen <>-1 Then233 If wParam =VK_BACK Then238 If _PromptSys_InputLen <> -1 Then 239 If wParam = VK_BACK Then 234 240 If _PromptSys_InputLen Then 235 _PromptSys_InputLen =_PromptSys_InputLen-1236 _PromptSys_InputStr[_PromptSys_InputLen] =0237 238 _PromptSys_CurPos.x =_PromptSys_CurPos.x-1239 _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] =0241 _PromptSys_InputLen-- 242 _PromptSys_InputStr[_PromptSys_InputLen] = 0 243 244 _PromptSys_CurPos.x-- 245 _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] = 0 240 246 End If 241 ElseIf wParam =VK_RETURN Then242 _PromptSys_InputStr[_PromptSys_InputLen] =0243 _PromptSys_InputLen =-1244 TempStr =Ex"\r\n"245 ElseIf wParam =&H16 Then247 ElseIf wParam = VK_RETURN Then 248 _PromptSys_InputStr[_PromptSys_InputLen] = 0 249 _PromptSys_InputLen = -1 250 TempStr = Ex"\r\n" 251 ElseIf wParam = &H16 Then 246 252 'Paste Command(Use Clippboard) 247 253 OpenClipboard(hWnd) 248 hGlobal=GetClipboardData(CF_TEXT)249 If hGlobal =0 Then PromptProc=0:Exit Function250 Dim pTemp =GlobalLock(hGlobal) As *Byte251 #ifdef UNICODE 254 Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL 255 If hGlobal = 0 Then Return 0 256 Dim pTemp = GlobalLock(hGlobal) As PCSTR 257 #ifdef UNICODE 'A版ウィンドウプロシージャ用 252 258 Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1 253 TempStr =ZeroString(tempSizeW)259 TempStr = ZeroString(tempSizeW) 254 260 MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW) 255 261 #else 256 TempStr =ZeroString(lstrlen(pTemp)+1)257 lstrcpy(StrPtr(TempStr), pTemp)262 TempStr = ZeroString(lstrlen(pTemp) + 1) 263 lstrcpy(StrPtr(TempStr), pTemp) 258 264 #endif 259 lstrcpy((VarPtr(_PromptSys_InputStr[0])+_PromptSys_InputLen) As *Byte,pTemp)260 _PromptSys_InputLen =_PromptSys_InputLen+lstrlen(pTemp)265 memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length) 266 _PromptSys_InputLen += TempStr.Length 261 267 262 268 GlobalUnlock(hGlobal) 263 269 CloseClipboard() 264 270 Else 265 _PromptSys_InputStr[_PromptSys_InputLen] =wParam As Byte271 _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte 266 272 _PromptSys_InputLen++ 267 273 268 temporary[0]=wParam As Byte 269 temporary[1]=0 270 TempStr=temporary 274 TempStr.ReSize(1) 275 TempStr[0] = wParam As Char 271 276 End If 272 277 273 SendMessage(hWnd, WM_KILLFOCUS,0,0)278 SendMessage(hWnd, WM_KILLFOCUS, 0, 0) 274 279 PRINT_ToPrompt(TempStr) 275 SendMessage(hWnd, WM_SETFOCUS,0,0)280 SendMessage(hWnd, WM_SETFOCUS, 0, 0) 276 281 End If 277 282 Case WM_DESTROY … … 292 297 'Allocate 293 298 For i=0 To 100 294 _PromptSys_Buffer[i] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)295 _PromptSys_TextColor[i] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))296 _PromptSys_BackColor[i] =HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))299 _PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255) 300 _PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255) 301 _PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255) 297 302 Next 298 303 … … 306 311 307 312 'LogFont initialize 308 _PromptSys_LogFont.lfHeight=-16 309 _PromptSys_LogFont.lfWidth=0 310 _PromptSys_LogFont.lfEscapement=0 311 _PromptSys_LogFont.lfOrientation=0 312 _PromptSys_LogFont.lfWeight=0 313 _PromptSys_LogFont.lfItalic=0 314 _PromptSys_LogFont.lfUnderline=0 315 _PromptSys_LogFont.lfStrikeOut=0 316 _PromptSys_LogFont.lfCharSet=SHIFTJIS_CHARSET 317 _PromptSys_LogFont.lfOutPrecision=OUT_DEFAULT_PRECIS 318 _PromptSys_LogFont.lfClipPrecision=CLIP_DEFAULT_PRECIS 319 _PromptSys_LogFont.lfQuality=DEFAULT_QUALITY 320 _PromptSys_LogFont.lfPitchAndFamily=FIXED_PITCH 321 lstrcpy(_PromptSys_LogFont.lfFaceName,"ＭＳ 明朝") 322 323 _PromptSys_hFont=CreateFontIndirect(_PromptSys_LogFont) 313 With _PromptSys_LogFont 314 .lfHeight = -16 315 .lfWidth = 0 316 .lfEscapement = 0 317 .lfOrientation = 0 318 .lfWeight = 0 319 .lfItalic = 0 320 .lfUnderline = 0 321 .lfStrikeOut = 0 322 .lfCharSet = SHIFTJIS_CHARSET 323 .lfOutPrecision = OUT_DEFAULT_PRECIS 324 .lfClipPrecision = CLIP_DEFAULT_PRECIS 325 .lfQuality = DEFAULT_QUALITY 326 .lfPitchAndFamily = FIXED_PITCH 327 lstrcpy(.lfFaceName, "ＭＳ 明朝") 328 End With 329 330 _PromptSys_hFont = CreateFontIndirect(ByVal VarPtr(_PromptSys_LogFont)) 324 331 325 332 'Critical Section … … 338 345 wcl.lpfnWndProc=AddressOf(PromptProc) 339 346 wcl.hbrBackground=GetStockObject(BLACK_BRUSH) 340 RegisterClassEx(wcl)347 Dim atom = RegisterClassEx(wcl) 341 348 342 349 'Create Prompt Window 343 _PromptSys_hWnd=CreateWindowEx(WS_EX_CLIENTEDGE, "PROMPT","BASIC PROMPT",WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,GetModuleHandle(0),0)350 _PromptSys_hWnd=CreateWindowEx(WS_EX_CLIENTEDGE,atom As ULONG_PTR As PCSTR,"BASIC PROMPT",WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,GetModuleHandle(0),0) 344 351 ShowWindow(_PromptSys_hWnd,SW_SHOW) 345 352 UpdateWindow(_PromptSys_hWnd) … … 353 360 Loop 354 361 362 '強制的に終了する 363 ExitProcess(0) 364 355 365 EnterCriticalSection(_PromptSys_SectionOfBufferAccess) 356 For i=0 to 100 357 HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[i]) 358 HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[i]) 359 HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[i]) 360 Next 361 362 '強制的に終了する 363 ExitProcess(0) 366 367 For i=0 to 100 368 _System_free(_PromptSys_Buffer[i]) 369 _System_free(_PromptSys_TextColor[i]) 370 _System_free(_PromptSys_BackColor[i]) 371 Next 364 372 365 373 LeaveCriticalSection(_PromptSys_SectionOfBufferAccess) … … 432 440 433 441 'Set value to variable 434 i =0435 i2 =0436 buf =ZeroString(lstrlen(_PromptSys_InputStr))442 i = 0 443 i2 = 0 444 buf = ZeroString(lstrlen(_PromptSys_InputStr)) 437 445 While 1 438 i3 =0446 i3 = 0 439 447 While 1 440 If _PromptSys_InputStr[i2] =Asc(",")Then441 buf.Chars[i3] =0448 If _PromptSys_InputStr[i2] = &h2c Then 449 buf.Chars[i3] = 0 442 450 Exit While 443 451 End If 444 452 445 buf.Chars[i3] =_PromptSys_InputStr[i2]446 447 If _PromptSys_InputStr[i2] =0 Then Exit While453 buf.Chars[i3] = _PromptSys_InputStr[i2] 454 455 If _PromptSys_InputStr[i2] = 0 Then Exit While 448 456 449 457 i2++ … … 451 459 Wend 452 460 453 Select Case _System_InputDataType[i] 454 Case _System_Type_Double 455 SetDouble(_System_InputDataPtr[i],Val(buf)) 456 Case _System_Type_Single 457 SetSingle(_System_InputDataPtr[i],Val(buf)) 458 Case _System_Type_Int64,_System_Type_QWord 459 SetQWord(_System_InputDataPtr[i],Val(buf)) 460 Case _System_Type_Long,_System_Type_DWord 461 SetDWord(_System_InputDataPtr[i],Val(buf)) 462 Case _System_Type_Integer,_System_Type_Word 463 SetWord(_System_InputDataPtr[i],Val(buf)) 464 Case _System_Type_SByte,_System_Type_Byte 465 SetByte(_System_InputDataPtr[i],Val(buf)) 466 Case _System_Type_Char 467 #ifdef UNICODE 468 SetWord(_System_InputDataPtr[i], buf[0]) 469 #else 470 SetByte(_System_InputDataPtr[i], buf[0]) 471 #endif 472 Case _System_Type_String 473 *INPUT_FromPrompt_Type_String 474 Dim pTempStr As *String 475 pTempStr=_System_InputDataPtr[i] As *String 476 pTempStr->ReSize(i3) 477 memcpy(pTempStr->Chars, buf.Chars, pTempStr->Length) 478 pTempStr->Chars[pTempStr->Length] = 0 479 Case 13 480 Goto *INPUT_FromPrompt_Type_String 481 End Select 461 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3) 482 462 483 463 i++ 484 If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]= Asc(",") Then464 If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=&h2c Then 'Asc(",") 485 465 PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n") 486 466 Goto *InputReStart … … 494 474 End If 495 475 496 i2 =i2+1476 i2++ 497 477 Wend 498 478 End Sub … … 534 514 'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2] 535 515 536 Dim hDC As HDC 537 Dim hPen As HPEN, hOldPen As VoidPtr 538 Dim hBrush As HBRUSH, hOldBrush As VoidPtr 516 Dim hBrush As HBRUSH 539 517 Dim radi2 As Long 540 518 Dim sw As Long 541 519 Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long 542 520 543 hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))521 Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode)) 544 522 If bFill Then 545 523 hBrush=CreateSolidBrush(GetBasicColor(BrushColor)) … … 548 526 End If 549 527 550 hDC=GetDC(_PromptSys_hWnd)528 Dim hDC=GetDC(_PromptSys_hWnd) 551 529 SelectObject(hDC,hPen) 552 530 SelectObject(hDC,hBrush) 553 hOldPen=SelectObject(_PromptSys_hMemDC,hPen)554 hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)531 Dim hOldPen=SelectObject(_PromptSys_hMemDC,hPen) 532 Dim hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush) 555 533 556 534 If Aspect<1 Then … … 664 642 End If 665 643 666 Dim hDC As HDC 667 Dim hPen As HPEN, hOldPen As VoidPtr 668 Dim hBrush As HBRUSH, hOldBrush As VoidPtr 669 670 hDC=GetDC(_PromptSys_hWnd) 671 hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode)) 644 Dim hDC = GetDC(_PromptSys_hWnd) 645 Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode)) 646 Dim hBrush As HBRUSH 672 647 If fType=2 Then 673 648 hBrush=CreateSolidBrush(GetBasicColor(BrushColor)) … … 678 653 SelectObject(hDC,hPen) 679 654 SelectObject(hDC,hBrush) 680 hOldPen=SelectObject(_PromptSys_hMemDC,hPen)681 hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)655 Dim hOldPen = SelectObject(_PromptSys_hMemDC,hPen) 656 Dim hOldBrush = SelectObject(_PromptSys_hMemDC,hBrush) 682 657 683 658 Select Case fType … … 710 685 'PSet (x,y),ColorCode 711 686 712 Dim hDC As HDC 713 714 hDC=GetDC(_PromptSys_hWnd) 687 Dim hDC=GetDC(_PromptSys_hWnd) 715 688 SetPixel(hDC,x,y,GetBasicColor(ColorCode)) 716 689 SetPixel(_PromptSys_hMemDC,x,y,GetBasicColor(ColorCode))
Note:
See TracChangeset
for help on using the changeset viewer.
