Changeset 125 for Include/basic

Timestamp:

Mar 2, 2007, 2:57:09 PM (18 years ago)

Author:

イグトランス (egtra)

Message:

#51完了

Location:

Include/basic

Files:

• function.sbp (modified) (2 diffs)
• prompt.sbp (modified) (14 diffs)

Include/basic/function.sbp

@@ -694 +694 @@
     Dim temp[255] As Char
 #ifdef _WIN64
-    _sntprintf(temp, Len (temp) / SizeOf (Char), "%I64d", value)
+    _sntprintf(temp, Len (temp) \ SizeOf (Char), "%I64d", value)
 #else
-    _sntprintf(temp, Len (temp) / SizeOf (Char), "%d", value)
+    _sntprintf(temp, Len (temp) \ SizeOf (Char), "%d", value)
 #endif
     Str$ = temp
@@ -1068 +1068 @@
 End Function
 
-Function _System_FillChar(p As *Char, n As SIZE_T, c As Char)
+Sub _System_FillChar(p As *Char, n As SIZE_T, c As Char)
     Dim i As SIZE_T
     For i = 0 To ELM(n)
         p[i] = c
     Next
+End Sub
+
+Function _System_ASCII_IsUpper(c As Char) As Boolean
+    Return c As DWord - &h41 < 26 ' &h41 = Asc("A")
+End Function
+
+Function _System_ASCII_IsLower(c As Char) As Boolean
+    Return c As DWord - &h61 < 26 ' &h61 = Asc("a")
+End Function
+
+Function _System_ASCII_ToLower(c As Char)
+    If _System_ASCII_IsUpper(c) Then
+        Return c Or &h20
+    Else
+        Return c
+    End If
+End Function
+
+Function _System_ASCII_ToUpper(c As Char)
+    If _System_ASCII_IsLower(c) Then
+        Return c And (Not &h20)
+    Else
+        Return c
+    End If
+End Function
+
+Function _System_WideCharToMultiByte(s As PCWSTR) As PSTR
+    Return _System_WideCharToMultiByte(s, lstrlenW(s) + 1, 0)
+End Function
+
+Function _System_WideCharToMultiByte(s As PCWSTR, size As Long) As PSTR
+    Return _System_WideCharToMultiByte(s, size, 0)
+End Function
+
+Function _System_WideCharToMultiByte(ws As PCWSTR, size As Long, flag As DWord) As PSTR
+    Dim sizeMBS = WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, 0, 0, 0, 0)
+    Dim mbs = malloc(sizeMBS) As PSTR
+    WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS, 0, 0)
+    Return mbs
+End Function
+
+Function _System_MultiByteToWideChar(s As PCSTR) As PWSTR
+    Return _System_MultiByteToWideChar(s, lstrlenA(s) + 1, 0)
+End Function
+
+Function _System_MultiByteToWideChar(s As PCSTR, size As Long) As PWSTR
+    Return _System_MultiByteToWideChar(s, size, 0)
+End Function
+
+Function _System_MultiByteToWideChar(s As PCSTR, size As Long, flag As DWord) As PWSTR
+    Dim sizeMBS = MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, 0, 0)
+    Dim mbs = malloc(SizeOf (WCHAR) * sizeMBS) As PWSTR
+    MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS)
+    Return mbs
 End Function
 

Include/basic/prompt.sbp

@@ -13 +13 @@
 
 'text
+
 Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
 Dim _PromptSys_hFont As HFONT
@@ -23 +24 @@
 Dim _PromptSys_TextColor[100] As *COLORREF
 Dim _PromptSys_BackColor[100] As *COLORREF
+Dim _PromptSys_TextWidth[100] As Long
 Dim _PromptSys_NowTextColor As COLORREF
 Dim _PromptSys_NowBackColor As COLORREF
@@ -45 +47 @@
 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
     Dim i As Long, i2 As Long, i3 As Long
-    Dim sz As SIZE
-    Dim temporary[2] As Char
 
     Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
@@ -53 +53 @@
     Dim rc As RECT
     GetClientRect(_PromptSys_hWnd, rc)
-    While (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy>rc.bottom and _PromptSys_CurPos.y>0
+    While (_PromptSys_CurPos.y+1) * _PromptSys_FontSize.cy > rc.bottom and _PromptSys_CurPos.y > 0
         _System_free(_PromptSys_Buffer[0])
         _System_free(_PromptSys_TextColor[0])
         _System_free(_PromptSys_BackColor[0])
-        For i=0 To 100-1
+        For i = 0 To 100 - 1
             _PromptSys_Buffer[i] = _PromptSys_Buffer[i+1]
             _PromptSys_TextColor[i] = _PromptSys_TextColor[i+1]
             _PromptSys_BackColor[i] = _PromptSys_BackColor[i+1]
+            _PromptSys_TextWidth[i] = _PromptSys_TextWidth[i+1]
         Next
         _PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255)
         _PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
         _PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
+        _PromptSys_TextWidth[100] = 0
 
         _PromptSys_CurPos.y--
 
         'Redraw
-        StartLine=-1
+        StartLine = -1
     Wend
 
-    i=0
-    While i*_PromptSys_FontSize.cy<rc.bottom and i<=100
+    i = 0
+    While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
         If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
+            Dim sz As SIZE
             i3 = lstrlen(_PromptSys_Buffer[i])
             GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)
 
             BitBlt(hDC,_
-                sz.cx, i*_PromptSys_FontSize.cy, _
+                sz.cx, i * _PromptSys_FontSize.cy, _
                 rc.right, _PromptSys_FontSize.cy, _
-                _PromptSys_hMemDC,sz.cx,i*_PromptSys_FontSize.cy,SRCCOPY)
-
+                _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)
+
+            Dim width = 0 As Long
             For i2 = 0 To i3-1
                 SetTextColor(hDC, _PromptSys_TextColor[i][i2])
@@ -92 +96 @@
                 End If
 
+                Dim temporary[2] As Char
                 Dim tempLen As Long
-                temporary[0]=_PromptSys_Buffer[i][i2]
+                temporary[0] = _PromptSys_Buffer[i][i2]
 #ifdef UNICODE
                 If _System_IsSurrogatePair(_PromptSys_Buffer[i][i2], _PromptSys_Buffer[i][i2+1]) Then
@@ -108 +113 @@
                 End If
                 With _PromptSys_FontSize
-                    TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen)
+                    TextOut(hDC, width, i * .cy, temporary, tempLen)
                 End With
+                GetTextExtentPoint32(hDC, temporary, i3, sz)
+                width += sz.cx
             Next
         End If
@@ -150 +157 @@
             .x++
         Loop
+
         'Draw the text buffer added
         Dim hDC = GetDC(_PromptSys_hWnd)
@@ -182 +190 @@
 
             Dim tm As TEXTMETRIC
-            Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
+            Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
             GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize)
             GetTextMetrics(_PromptSys_hMemDC, tm)
@@ -190 +198 @@
             ReleaseDC(hWnd,hDC)
         Case WM_PAINT
-            hDC = BeginPaint(hWnd,ps)
+            hDC = BeginPaint(hWnd, ps)
+/*
             With _PromptSys_ScreenSize
                 BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
+*/
+            With ps.rcPaint
+                BitBlt(hDC, .left, .top, .right - .left, .bottom - .top, _PromptSys_hMemDC, .left, .top, SRCCOPY)
             End With
             DrawPromptBuffer(hDC, -1, 0)
@@ -270 +282 @@
                 SendMessage(hWnd, WM_SETFOCUS, 0, 0)
             End If
+        Case WM_IME_COMPOSITION
+            Return _PromptSys_OnImeCompostion(hWnd, wParam, lParam)
         Case WM_DESTROY
             DeleteDC(_PromptSys_hMemDC)
@@ -282 +296 @@
 End Function
 
+Function _PromptSys_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT
+    If (lp And GCS_RESULTSTR) <> 0 Then
+        Dim himc = ImmGetContext(hwnd)
+        If himc = 0 Then
+            'Debug
+            Return 0
+        End If
+        Dim size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
+        Dim str = _System_malloc(size) As PTSTR
+        If str = 0 Then
+            'Debug
+            Return 0
+        End If
+        ImmGetCompositionString(himc, GCS_RESULTSTR, str, size)
+        ImmReleaseContext(hwnd, himc)
+
+        memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size)
+        _PromptSys_InputLen += size
+
+        Dim tempStr As String(str, size \ SizeOf (Char))
+        _System_free(str)
+
+        SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
+        PRINT_ToPrompt(tempStr)
+        SendMessage(hwnd, WM_SETFOCUS, 0, 0)
+
+        Return 0
+    Else
+        Return DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp)
+    End If
+End Function
+
 Function PromptMain(dwData As Long) As Long
     Dim i As Long
@@ -297 +343 @@
 
     'Setup
-    _PromptSys_ScreenSize.cx=GetSystemMetrics(SM_CXSCREEN)
-    _PromptSys_ScreenSize.cy=GetSystemMetrics(SM_CYSCREEN)
+    With _PromptSys_ScreenSize
+        .cx = GetSystemMetrics(SM_CXSCREEN)
+        .cy = GetSystemMetrics(SM_CYSCREEN)
+    End With
 
     'LogFont initialize
@@ -315 +363 @@
         .lfQuality = DEFAULT_QUALITY
         .lfPitchAndFamily = FIXED_PITCH
+#ifdef UNICODE
+        WideCharToMultiByte(CP_ACP, 0, "ＭＳ 明朝", 5, .lfFaceName, LF_FACESIZE, 0, 0)
+#else
         lstrcpy(.lfFaceName, "ＭＳ 明朝")
+#endif
     End With
 
-    _PromptSys_hFont = CreateFontIndirect(ByVal VarPtr(_PromptSys_LogFont))
+    _PromptSys_hFont = CreateFontIndirectA(ByVal VarPtr(_PromptSys_LogFont))
 
     'Critical Section
@@ -340 +392 @@
 
     'Create Prompt Window
-    _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)
+    _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, wcl.hInstance, 0)
     ShowWindow(_PromptSys_hWnd, SW_SHOW)
     UpdateWindow(_PromptSys_hWnd)