Changeset 411 for trunk/Include/basic/prompt.sbp

Timestamp:

Feb 23, 2008, 5:37:00 PM (16 years ago)

Author:

イグトランス (egtra)

Message:

UTF8Encoding（仮）の追加

File:

• trunk/Include/basic/prompt.sbp (modified) (18 diffs)

trunk/Include/basic/prompt.sbp

@@ -4 +4 @@
 #ifndef _INC_PROMPT
 #define _INC_PROMPT
-
-#require <api_imm.sbp>
-#require <Classes/System/Math.ab>
-#require <Classes/System/Environment.ab>
 
 Namespace ActiveBasic
@@ -23 +19 @@
 Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long
     _PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb)
+    If _PromptSys_TextOut = 0 Then Debug
 End Function
 
@@ -65 +62 @@
 Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION
 
-Dim _System_OSVersionInfo As OSVERSIONINFO
-
 
 'graphic
@@ -86 +81 @@
 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
     Dim i As Long, i2 As Long, i3 As Long
+    Dim ret As Long
 
     Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
@@ -118 +114 @@
             _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)
 
-            BitBlt(hDC,_
-                sz.cx, i * _PromptSys_FontSize.cy, _
-                rc.right, _PromptSys_FontSize.cy, _
-                _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)
+'           BitBlt(hDC,_
+'               sz.cx, i * _PromptSys_FontSize.cy, _
+'               rc.right, _PromptSys_FontSize.cy, _
+'               _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)
 
             While i2 < i3
@@ -128 +124 @@
                     SetBkMode(hDC, TRANSPARENT)
                 Else
-                    SetBkMode(hDC, OPAQUE)
-                    SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
+                    Debug
+                    ret = SetBkMode(hDC, OPAQUE)
+                    ret = SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
                 End If
 
@@ -152 +149 @@
 
 Sub PRINT_ToPrompt(buf As String)
+    OutputDebugString(ToTCStr(Ex"PRINT_ToPrompt " + buf + Ex"\r\n"))
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
+    If buf = "あ" Then Debug
     With _PromptSys_CurPos
         Dim hdc = GetDC(_PromptSys_hWnd)
         Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
-        Dim StartLine As Long : StartLine = .y
+        Dim StartLine = .y As Long
         Dim bufLen = buf.Length
         Dim doubleUnitChar = False As Boolean
@@ -194 +193 @@
                         _PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *StrChar, charLen, sz)
                         currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
-/*
-                        Dim buf[1023] As Char
-                        wsprintf(buf, Ex"%d %d\r\n", currentLineCharInfo[.x + 1].StartPos, currentLineCharInfo[.x].StartPos + sz.cx)
-                        OutputDebugString(buf)
-*/
                     End If
                 End If
@@ -207 +201 @@
 
         'Draw the text buffer added
-        DrawPromptBuffer(hdc, StartLine, .y)
+        'DrawPromptBuffer(hdc, StartLine, .y)
+        InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE)
+        UpdateWindow(_PromptSys_hWnd)
         SelectObject(hdc, hOldFont)
         ReleaseDC(_PromptSys_hWnd, hdc)
@@ -262 +258 @@
         .cy = tm.tmHeight
     End With
+
+    '_PromptSys_hFont initialize
+    Dim lf As LOGFONT
+    With lf
+        .lfHeight = -MulDiv(12, GetDeviceCaps(hdc, LOGPIXELSY), 72)
+        .lfWidth = 0
+        .lfEscapement = 0
+        .lfOrientation = 0
+        .lfWeight = 0
+        .lfItalic = 0
+        .lfUnderline = 0
+        .lfStrikeOut = 0
+        .lfCharSet = SHIFTJIS_CHARSET
+        .lfOutPrecision = OUT_DEFAULT_PRECIS
+        .lfClipPrecision = CLIP_DEFAULT_PRECIS
+        .lfQuality = DEFAULT_QUALITY
+        .lfPitchAndFamily = FIXED_PITCH
+        lstrcpy(.lfFaceName, ToTCStr("ＭＳ 明朝"))
+    End With
+
+    _PromptSys_hFont = CreateFontIndirect(lf)
 
     ReleaseDC(hwnd, hdc)
@@ -378 +395 @@
 Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long
     Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
-    rpsz = _System_malloc(size) As PWSTR
+    rpsz = GC_malloc(size) As PWSTR
     If rpsz = 0 Then
         'Debug
@@ -388 +405 @@
 Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long
     Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
-    rpsz = _System_malloc(size) As PSTR
+    rpsz = GC_malloc(size) As PSTR
     If rpsz = 0 Then
         'Debug
@@ -423 +440 @@
 #endif
         ImmReleaseContext(hwnd, himc)
-        _System_free(str)
 
         ActiveBasic.Strings.ChrCopy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.StrPtr, tempStr.Length As SIZE_T)
@@ -439 +455 @@
 
 Function PromptMain(dwData As Long) As Long
-    GetVersionEx(_System_OSVersionInfo)
-
     Dim i As Long
     'Allocate
@@ -460 +474 @@
         .cy = GetSystemMetrics(SM_CYSCREEN)
     End With
-
-    '_PromptSys_hFont initialize
-    Dim lf As LOGFONT
-    With lf
-        .lfHeight = -16
-        .lfWidth = 0
-        .lfEscapement = 0
-        .lfOrientation = 0
-        .lfWeight = 0
-        .lfItalic = 0
-        .lfUnderline = 0
-        .lfStrikeOut = 0
-        .lfCharSet = SHIFTJIS_CHARSET
-        .lfOutPrecision = OUT_DEFAULT_PRECIS
-        .lfClipPrecision = CLIP_DEFAULT_PRECIS
-        .lfQuality = DEFAULT_QUALITY
-        .lfPitchAndFamily = FIXED_PITCH
-        lstrcpy(.lfFaceName, ToTCStr("ＭＳ 明朝"))
-    End With
-
-    _PromptSys_hFont = CreateFontIndirect(lf)
 
     'Critical Section
@@ -604 +597 @@
             Goto *InputReStart
         End If
-        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i].ToString)
+        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i])
     Next
 
@@ -624 +617 @@
     Dim i = _PromptSys_TextLine[y].Length
     If i < x Then
-        _System_FillChar(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20 As StrChar) 'Asc(" ")
+        ActiveBasic.Strings.ChrFill(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20 As StrChar) 'Asc(" ")
         Dim i2 As Long
         For i2 = i To ELM(x)
@@ -664 +657 @@
         Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
     Else
-        Dim sw As Long
+        Dim sw As Boolean
         StartPos *=StartPos
         EndPos *=EndPos
 
         If StartPos<0 Or EndPos<0 Then
-            sw=1
+            sw = True
         Else
-            sw=0
+            sw = False
         End If