Changeset 125 for Include/basic/prompt.sbp
- Timestamp:
- Mar 2, 2007, 2:57:09 PM (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/basic/prompt.sbp
r123 r125 13 13 14 14 'text 15 15 16 Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT 16 17 Dim _PromptSys_hFont As HFONT … … 23 24 Dim _PromptSys_TextColor[100] As *COLORREF 24 25 Dim _PromptSys_BackColor[100] As *COLORREF 26 Dim _PromptSys_TextWidth[100] As Long 25 27 Dim _PromptSys_NowTextColor As COLORREF 26 28 Dim _PromptSys_NowBackColor As COLORREF … … 45 47 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long) 46 48 Dim i As Long, i2 As Long, i3 As Long 47 Dim sz As SIZE48 Dim temporary[2] As Char49 49 50 50 Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT … … 53 53 Dim rc As RECT 54 54 GetClientRect(_PromptSys_hWnd, rc) 55 While (_PromptSys_CurPos.y+1) *_PromptSys_FontSize.cy>rc.bottom and _PromptSys_CurPos.y>055 While (_PromptSys_CurPos.y+1) * _PromptSys_FontSize.cy > rc.bottom and _PromptSys_CurPos.y > 0 56 56 _System_free(_PromptSys_Buffer[0]) 57 57 _System_free(_PromptSys_TextColor[0]) 58 58 _System_free(_PromptSys_BackColor[0]) 59 For i =0 To 100-159 For i = 0 To 100 - 1 60 60 _PromptSys_Buffer[i] = _PromptSys_Buffer[i+1] 61 61 _PromptSys_TextColor[i] = _PromptSys_TextColor[i+1] 62 62 _PromptSys_BackColor[i] = _PromptSys_BackColor[i+1] 63 _PromptSys_TextWidth[i] = _PromptSys_TextWidth[i+1] 63 64 Next 64 65 _PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255) 65 66 _PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255) 66 67 _PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255) 68 _PromptSys_TextWidth[100] = 0 67 69 68 70 _PromptSys_CurPos.y-- 69 71 70 72 'Redraw 71 StartLine =-173 StartLine = -1 72 74 Wend 73 75 74 i =075 While i *_PromptSys_FontSize.cy<rc.bottom and i<=10076 i = 0 77 While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100 76 78 If StartLine=-1 or (StartLine<=i and i<=EndLine) Then 79 Dim sz As SIZE 77 80 i3 = lstrlen(_PromptSys_Buffer[i]) 78 81 GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz) 79 82 80 83 BitBlt(hDC,_ 81 sz.cx, i *_PromptSys_FontSize.cy, _84 sz.cx, i * _PromptSys_FontSize.cy, _ 82 85 rc.right, _PromptSys_FontSize.cy, _ 83 _PromptSys_hMemDC,sz.cx,i*_PromptSys_FontSize.cy,SRCCOPY) 84 86 _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY) 87 88 Dim width = 0 As Long 85 89 For i2 = 0 To i3-1 86 90 SetTextColor(hDC, _PromptSys_TextColor[i][i2]) … … 92 96 End If 93 97 98 Dim temporary[2] As Char 94 99 Dim tempLen As Long 95 temporary[0] =_PromptSys_Buffer[i][i2]100 temporary[0] = _PromptSys_Buffer[i][i2] 96 101 #ifdef UNICODE 97 102 If _System_IsSurrogatePair(_PromptSys_Buffer[i][i2], _PromptSys_Buffer[i][i2+1]) Then … … 108 113 End If 109 114 With _PromptSys_FontSize 110 TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen)115 TextOut(hDC, width, i * .cy, temporary, tempLen) 111 116 End With 117 GetTextExtentPoint32(hDC, temporary, i3, sz) 118 width += sz.cx 112 119 Next 113 120 End If … … 150 157 .x++ 151 158 Loop 159 152 160 'Draw the text buffer added 153 161 Dim hDC = GetDC(_PromptSys_hWnd) … … 182 190 183 191 Dim tm As TEXTMETRIC 184 Dim hOldFont =SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT192 Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT 185 193 GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize) 186 194 GetTextMetrics(_PromptSys_hMemDC, tm) … … 190 198 ReleaseDC(hWnd,hDC) 191 199 Case WM_PAINT 192 hDC = BeginPaint(hWnd,ps) 200 hDC = BeginPaint(hWnd, ps) 201 /* 193 202 With _PromptSys_ScreenSize 194 203 BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY) 204 */ 205 With ps.rcPaint 206 BitBlt(hDC, .left, .top, .right - .left, .bottom - .top, _PromptSys_hMemDC, .left, .top, SRCCOPY) 195 207 End With 196 208 DrawPromptBuffer(hDC, -1, 0) … … 270 282 SendMessage(hWnd, WM_SETFOCUS, 0, 0) 271 283 End If 284 Case WM_IME_COMPOSITION 285 Return _PromptSys_OnImeCompostion(hWnd, wParam, lParam) 272 286 Case WM_DESTROY 273 287 DeleteDC(_PromptSys_hMemDC) … … 282 296 End Function 283 297 298 Function _PromptSys_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT 299 If (lp And GCS_RESULTSTR) <> 0 Then 300 Dim himc = ImmGetContext(hwnd) 301 If himc = 0 Then 302 'Debug 303 Return 0 304 End If 305 Dim size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 306 Dim str = _System_malloc(size) As PTSTR 307 If str = 0 Then 308 'Debug 309 Return 0 310 End If 311 ImmGetCompositionString(himc, GCS_RESULTSTR, str, size) 312 ImmReleaseContext(hwnd, himc) 313 314 memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size) 315 _PromptSys_InputLen += size 316 317 Dim tempStr As String(str, size \ SizeOf (Char)) 318 _System_free(str) 319 320 SendMessage(hwnd, WM_KILLFOCUS, 0, 0) 321 PRINT_ToPrompt(tempStr) 322 SendMessage(hwnd, WM_SETFOCUS, 0, 0) 323 324 Return 0 325 Else 326 Return DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp) 327 End If 328 End Function 329 284 330 Function PromptMain(dwData As Long) As Long 285 331 Dim i As Long … … 297 343 298 344 'Setup 299 _PromptSys_ScreenSize.cx=GetSystemMetrics(SM_CXSCREEN) 300 _PromptSys_ScreenSize.cy=GetSystemMetrics(SM_CYSCREEN) 345 With _PromptSys_ScreenSize 346 .cx = GetSystemMetrics(SM_CXSCREEN) 347 .cy = GetSystemMetrics(SM_CYSCREEN) 348 End With 301 349 302 350 'LogFont initialize … … 315 363 .lfQuality = DEFAULT_QUALITY 316 364 .lfPitchAndFamily = FIXED_PITCH 365 #ifdef UNICODE 366 WideCharToMultiByte(CP_ACP, 0, "MS 明朝", 5, .lfFaceName, LF_FACESIZE, 0, 0) 367 #else 317 368 lstrcpy(.lfFaceName, "MS 明朝") 369 #endif 318 370 End With 319 371 320 _PromptSys_hFont = CreateFontIndirect (ByVal VarPtr(_PromptSys_LogFont))372 _PromptSys_hFont = CreateFontIndirectA(ByVal VarPtr(_PromptSys_LogFont)) 321 373 322 374 'Critical Section … … 340 392 341 393 'Create Prompt Window 342 _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) 394 _PromptSys_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, atom As ULONG_PTR As PCSTR, "BASIC PROMPT", 395 WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 396 0, 0, wcl.hInstance, 0) 343 397 ShowWindow(_PromptSys_hWnd, SW_SHOW) 344 398 UpdateWindow(_PromptSys_hWnd)
Note:
See TracChangeset
for help on using the changeset viewer.