Changeset 126 for Include

Timestamp:

Mar 3, 2007, 5:53:34 PM (18 years ago)

Author:

イグトランス (egtra)

Message:

#68修正完了

Location:

Include/basic

Files:

• function.sbp (modified) (3 diffs)
• prompt.sbp (modified) (30 diffs)

Include/basic/function.sbp

@@ -1068 +1068 @@
 End Function
 
+Function _System_IsDoubleUnitChar(lead As Char, trail As Char) As Boolean
+#ifdef UNICODE
+    Return _System_IsSurrogatePair(lead, trail)
+#else
+    Return IsDBCSLeadByte(lead) <> FALSE
+#endif
+End Function
+
 Sub _System_FillChar(p As *Char, n As SIZE_T, c As Char)
     Dim i As SIZE_T
@@ -1083 +1091 @@
 End Function
 
-Function _System_ASCII_ToLower(c As Char)
+Function _System_ASCII_ToLower(c As Char) As Char
     If _System_ASCII_IsUpper(c) Then
         Return c Or &h20
@@ -1091 +1099 @@
 End Function
 
-Function _System_ASCII_ToUpper(c As Char)
+Function _System_ASCII_ToUpper(c As Char) As Char
     If _System_ASCII_IsLower(c) Then
         Return c And (Not &h20)

Include/basic/prompt.sbp

@@ -6 +6 @@
 
 
-#include <api_imm.sbp>
+#require <api_imm.sbp>
+#require <Classes/System/Math.ab>
 
 Dim _PromptSys_hWnd As HWND
@@ -13 +14 @@
 
 'text
+Type _PromptSys_CharacterInformation
+    ForeColor As COLORREF
+    BackColor As COLORREF
+    StartPos As Long
+End Type
+
+Type _PromptSys_LineInformation
+    Length As Long
+    Text As *Char
+    CharInfo As *_PromptSys_CharacterInformation
+End Type
 
 Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
@@ -21 +33 @@
 Dim _PromptSys_KeyChar As Byte
 Dim _PromptSys_CurPos As POINTAPI
-Dim _PromptSys_Buffer[100] As *Char
-Dim _PromptSys_TextColor[100] As *COLORREF
-Dim _PromptSys_BackColor[100] As *COLORREF
-Dim _PromptSys_TextWidth[100] As Long
+Dim _PromptSys_TextLine[100] As _PromptSys_LineInformation
 Dim _PromptSys_NowTextColor As COLORREF
 Dim _PromptSys_NowBackColor As COLORREF
@@ -30 +39 @@
 
 
-_PromptSys_InputLen=-1
+_PromptSys_InputLen = -1
 
 'graphic
@@ -38 +47 @@
 Dim _PromptSys_GlobalPos As POINTAPI
 
-
-_PromptSys_bInitFinish=0
+CreateEvent(0, FALSE, FALSE, 0)
+_PromptSys_bInitFinish = 0
 CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID)
 Do
@@ -54 +63 @@
     GetClientRect(_PromptSys_hWnd, rc)
     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])
+        _System_free(_PromptSys_TextLine[0].Text)
+        _System_free(_PromptSys_TextLine[0].CharInfo)
         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]
+            _PromptSys_TextLine[i].Length = _PromptSys_TextLine[i+1].Length
+            _PromptSys_TextLine[i].Text = _PromptSys_TextLine[i+1].Text
+            _PromptSys_TextLine[i].CharInfo = _PromptSys_TextLine[i+1].CharInfo
         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_TextLine[100].Length = 0
+        _PromptSys_TextLine[100].Text = _System_calloc(SizeOf (Char) * 255)
+        _PromptSys_TextLine[100].CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
         _PromptSys_CurPos.y--
 
@@ -74 +79 @@
     Wend
 
-    i = 0
+    i = 0' : Debug
     While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
         If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
+            Dim currentLineCharInfo = _PromptSys_TextLine[i].CharInfo
+
             Dim sz As SIZE
-            i3 = lstrlen(_PromptSys_Buffer[i])
-            GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)
+            i3 = lstrlen(_PromptSys_TextLine[i].Text) '_PromptSys_TextLine[i].Length
+            If i3 <> 0 Then
+                OutputDebugString(Str$(i3) + ":" + Str$(_PromptSys_TextLine[i].Length) + Ex"\r\n")
+            End If
+            GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)
 
             BitBlt(hDC,_
@@ -86 +96 @@
                 _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])
-                If _PromptSys_BackColor[i][i2] = -1 Then
+            While i2 < i3
+                SetTextColor(hDC, currentLineCharInfo[i2].ForeColor)
+                If currentLineCharInfo[i2].BackColor = -1 Then
                     SetBkMode(hDC, TRANSPARENT)
                 Else
                     SetBkMode(hDC, OPAQUE)
-                    SetBkColor(hDC, _PromptSys_BackColor[i][i2])
+                    SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
                 End If
 
-                Dim temporary[2] As Char
                 Dim tempLen As Long
-                temporary[0] = _PromptSys_Buffer[i][i2]
-#ifdef UNICODE
-                If _System_IsSurrogatePair(_PromptSys_Buffer[i][i2], _PromptSys_Buffer[i][i2+1]) Then
-#else
-                If IsDBCSLeadByte(temporary[0]) Then
-#endif
-                    temporary[1] = _PromptSys_Buffer[i][i2+1]
-                    temporary[2] = 0
-                    i2++
+                If _System_IsDoubleUnitChar(_PromptSys_TextLine[i].Text[i2], _PromptSys_TextLine[i].Text[i2+1]) Then
                     tempLen = 2
                 Else
-                    temporary[1] = 0
                     tempLen = 1
                 End If
                 With _PromptSys_FontSize
-                    TextOut(hDC, width, i * .cy, temporary, tempLen)
+                    TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]), tempLen)
                 End With
-                GetTextExtentPoint32(hDC, temporary, i3, sz)
-                width += sz.cx
-            Next
+                i2 += tempLen
+            Wend
         End If
 
@@ -129 +127 @@
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
     With _PromptSys_CurPos
-        Dim StartLine As Long
-        StartLine = .y
+        Dim hdc = GetDC(_PromptSys_hWnd)
+        Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
+        Dim StartLine As Long : StartLine = .y
+        Dim bufLen = buf.Length
+        Dim doubleUnitChar = False As Boolean
         'Addition
-        Dim i2 = 0 As Long, i3 As Long
-        Do
-            If buf[i2] = 9 Then 'tab
-                i3 = 8 - (.x And 7) '(.x mod 8)
-                _System_FillChar(VarPtr(_PromptSys_Buffer[.y][.x]), i3, &h20) 'Asc(" ")
-                i2++
-                .x += i3
-                Continue
+        Dim i2 = 0 As Long, i3 As Long' : Debug
+        For i2 = 0 To ELM(bufLen)
+            If buf[i2] = &h0d Then 'CR \r
+                _PromptSys_TextLine[.y].Length = .x
+                .x = 0
+            ElseIf buf[i2] = &h0a Then 'LF \n
+                _PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)
+                .y++
+            Else
+                Dim currentLineCharInfo = _PromptSys_TextLine[.y].CharInfo As *_PromptSys_CharacterInformation
+                _PromptSys_TextLine[.y].Text[.x] = buf[i2]
+                currentLineCharInfo[.x].ForeColor = _PromptSys_NowTextColor
+                currentLineCharInfo[.x].BackColor = _PromptSys_NowBackColor
+
+                If buf[i2] = &h09 Then 'tab
+                    Dim tabStop = _PromptSys_FontSize.cx * 8
+                    currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + _
+                        tabStop - currentLineCharInfo[.x].StartPos Mod tabStop
+                Else
+                    If doubleUnitChar <> False Then
+                        doubleUnitChar = False
+                        currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos
+                    Else
+                        Dim sz As SIZE
+                        Dim charLen As Long
+                        If _System_IsDoubleUnitChar(buf[i2], buf[i2 + 1]) Then
+                            charLen = 2
+                            doubleUnitChar = True
+                        Else
+                            charLen = 1
+                        EndIf
+                        GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]), 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
+                .x++
             End If
-
-            If buf[i2] = 13 and buf[i2+1] = 10 Then '\r\n
-                i2 += 2
-                .y++
-                .x = 0
-                Continue
-            End If
-
-            If buf[i2] = 0 Then Exit Do
-            _PromptSys_Buffer[.y][.x] = buf[i2]
-            _PromptSys_TextColor[.y][.x] = _PromptSys_NowTextColor
-            _PromptSys_BackColor[.y][.x] = _PromptSys_NowBackColor
-
-            i2++
-            .x++
-        Loop
+        Next
+        _PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)
 
         'Draw the text buffer added
-        Dim hDC = GetDC(_PromptSys_hWnd)
-        DrawPromptBuffer(hDC, StartLine, .y)
-        ReleaseDC(_PromptSys_hWnd, hDC)
+        DrawPromptBuffer(hdc, StartLine, .y)
+        SelectObject(hdc, hOldFont)
+        ReleaseDC(_PromptSys_hWnd, hdc)
     End With
     LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
@@ -167 +187 @@
 
 Function PromptProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
-    Dim hIMC As HIMC
-    Dim hDC As HDC
-    Dim ps As PAINTSTRUCT
-    Dim TempStr As String
-    Dim CompForm As COMPOSITIONFORM
-
     Select Case message
         Case WM_CREATE
-            hDC = GetDC(hWnd)
-            With _PromptSys_ScreenSize
-                _PromptSys_hBitmap = CreateCompatibleBitmap(hDC, .cx, .cy)
-            End With
-            _PromptSys_hMemDC = CreateCompatibleDC(hDC)
-            SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap)
-
-            'Initialize for Win9x
-            Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
-            With _PromptSys_ScreenSize
-                PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
-            End With
-            SelectObject(_PromptSys_hMemDC, hOldBrush)
-
-            Dim tm As TEXTMETRIC
-            Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
-            GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize)
-            GetTextMetrics(_PromptSys_hMemDC, tm)
-            SelectObject(_PromptSys_hMemDC, hOldFont)
-            _PromptSys_FontSize.cy = tm.tmHeight
-
-            ReleaseDC(hWnd,hDC)
+            Return _PromptWnd_OnCreate(hWnd, ByVal lParam As *CREATESTRUCT)
         Case WM_PAINT
-            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)
-            EndPaint(hWnd, ps)
-
-            _PromptSys_bInitFinish = TRUE
+            _PromptWnd_OnPaint(hWnd)
         Case WM_SETFOCUS
-            If _PromptSys_InputLen<>-1 Then
-                hIMC = ImmGetContext(hWnd)
-                If hIMC Then
-                    With CompForm
-                        .dwStyle = CFS_POINT
-                        .ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx
-                        .ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy
-                    End With
-                    ImmSetCompositionWindow(hIMC, CompForm)
-                    ImmSetCompositionFontA(hIMC, _PromptSys_LogFont)
-                End If
-                ImmReleaseContext(hWnd, hIMC)
-
-                CreateCaret(hWnd, NULL, 9, 6)
-                SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _
-                    (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7)
-                ShowCaret(hWnd)
-            End If
+            _PromptWnd_OnSetFocus(hWnd, wParam As HWND)
         Case WM_KILLFOCUS
-            HideCaret(hWnd)
-            DestroyCaret()
+            _PromptWnd_OnKillForcus(hWnd, wParam As HWND)
         Case WM_KEYDOWN
-            If _PromptSys_InputLen=-1 Then
-                _PromptSys_KeyChar=wParam As Byte
-            End If
+            _PromptWnd_OnKeyDown(wParam As DWord, LOWORD(lParam) As DWord, HIWORD(lParam) As DWord)
         Case WM_CHAR
-            If _PromptSys_InputLen <> -1 Then
-                If wParam = VK_BACK Then
-                    If _PromptSys_InputLen Then
-                        _PromptSys_InputLen--
-                        _PromptSys_InputStr[_PromptSys_InputLen] = 0
-
-                        _PromptSys_CurPos.x--
-                        _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] = 0
-                    End If
-                ElseIf wParam = VK_RETURN Then
-                    _PromptSys_InputStr[_PromptSys_InputLen] = 0
-                    _PromptSys_InputLen = -1
-                    TempStr = Ex"\r\n"
-                ElseIf wParam = &H16 Then
-                    'Paste Command(Use Clippboard)
-                    OpenClipboard(hWnd)
-                    Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
-                    If hGlobal = 0 Then Return 0
-                    Dim pTemp = GlobalLock(hGlobal) As PCSTR
-#ifdef UNICODE 'A版ウィンドウプロシージャ用
-                    Dim tempSizeA = lstrlenA(pTemp)
-                    Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1
-                    TempStr = ZeroString(tempSizeW)
-                    MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW)
-#else
-                    TempStr = ZeroString(lstrlen(pTemp) + 1)
-                    lstrcpy(StrPtr(TempStr), pTemp)
-#endif
-                    memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length)
-                    _PromptSys_InputLen += TempStr.Length
-
-                    GlobalUnlock(hGlobal)
-                    CloseClipboard()
-                Else
-                    _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
-                    _PromptSys_InputLen++
-
-                    TempStr.ReSize(1)
-                    TempStr[0] = wParam As Char
-                End If
-
-                SendMessage(hWnd, WM_KILLFOCUS, 0, 0)
-                PRINT_ToPrompt(TempStr)
-                SendMessage(hWnd, WM_SETFOCUS, 0, 0)
-            End If
+            _PromptWnd_OnChar(hWnd, wParam, lParam)
         Case WM_IME_COMPOSITION
-            Return _PromptSys_OnImeCompostion(hWnd, wParam, lParam)
+            Return _PromptWnd_OnImeCompostion(hWnd, wParam, lParam)
         Case WM_DESTROY
-            DeleteDC(_PromptSys_hMemDC)
-            DeleteObject(_PromptSys_hBitmap)
-
-            PostQuitMessage(0)
+            _PromptWnd_OnDestroy(hWnd)
         Case Else
-            PromptProc=DefWindowProc(hWnd,message,wParam,lParam)
+            PromptProc = DefWindowProc(hWnd, message, wParam, lParam)
             Exit Function
     End Select
-    PromptProc=0
+    PromptProc = 0
 End Function
 
-Function _PromptSys_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT
+Function _PromptWnd_OnCreate(hwnd As HWND, ByRef cs As CREATESTRUCT) As LRESULT
+    Dim hdc = GetDC(hwnd)
+    With _PromptSys_ScreenSize
+        _PromptSys_hBitmap = CreateCompatibleBitmap(hdc, .cx, .cy)
+    End With
+    _PromptSys_hMemDC = CreateCompatibleDC(hdc)
+    SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap)
+
+    'Initialize for Win9x
+    Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
+    With _PromptSys_ScreenSize
+        PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
+    End With
+    SelectObject(_PromptSys_hMemDC, hOldBrush)
+
+    Dim tm As TEXTMETRIC
+    Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
+    GetTextMetrics(_PromptSys_hMemDC, tm)
+    SelectObject(_PromptSys_hMemDC, hOldFont)
+    With _PromptSys_FontSize
+        .cx = tm.tmAveCharWidth
+        .cy = tm.tmHeight
+    End With
+
+    ReleaseDC(hwnd, hdc)
+
+    _PromptWnd_OnCreate = 0
+End Function
+
+Sub _PromptWnd_OnPaint(hwnd As HWND)
+    Dim ps As PAINTSTRUCT
+    Dim 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)
+    EndPaint(hwnd, ps)
+
+    _PromptSys_bInitFinish = TRUE
+End Sub
+
+Sub _PromptWnd_OnSetFocus(hwnd As HWND, hwndOldFocus As HWND)
+    If _PromptSys_InputLen <> -1 Then
+        Dim himc = ImmGetContext(hwnd)
+        If himc Then
+            Dim CompForm As COMPOSITIONFORM
+            With CompForm
+                .dwStyle = CFS_POINT
+                .ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx
+                .ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy
+            End With
+            ImmSetCompositionWindow(himc, CompForm)
+            ImmSetCompositionFontA(himc, _PromptSys_LogFont)
+        End If
+        ImmReleaseContext(hwnd, himc)
+
+        CreateCaret(hwnd, 0, 9, 6)
+        SetCaretPos(_PromptSys_CurPos.x * _PromptSys_FontSize.cx, (_PromptSys_CurPos.y + 1) * _PromptSys_FontSize.cy - 7)
+        ShowCaret(hwnd)
+    End If
+End Sub
+
+Sub _PromptWnd_OnKillForcus(hwnd As HWND, hwndNewFocus As HWND)
+    HideCaret(hwnd)
+    DestroyCaret()
+End Sub
+
+Sub _PromptWnd_OnKeyDown(vk As DWord, repeat As DWord, flags As DWord)
+    If _PromptSys_InputLen = -1 Then
+        _PromptSys_KeyChar = vk As Byte
+    End If
+End Sub
+
+Sub _PromptWnd_OnDestroy(hwnd As HWND)
+    DeleteDC(_PromptSys_hMemDC)
+    DeleteObject(_PromptSys_hBitmap)
+
+    PostQuitMessage(0)
+End Sub
+
+Sub _PromptWnd_OnChar(hwnd As HWND, wParam As WPARAM, lParam As LPARAM)
+    Dim TempStr As String
+    If _PromptSys_InputLen <> -1 Then
+        If wParam = VK_BACK Then
+            If _PromptSys_InputLen Then
+                _PromptSys_InputLen--
+                _PromptSys_InputStr[_PromptSys_InputLen] = 0
+
+                _PromptSys_CurPos.x--
+                With _PromptSys_CurPos
+                    _PromptSys_TextLine[.y].Text[.x] = 0
+                End With
+            End If
+        ElseIf wParam = VK_RETURN Then
+            _PromptSys_InputStr[_PromptSys_InputLen] = 0
+            _PromptSys_InputLen = -1
+            TempStr = Ex"\r\n"
+        ElseIf wParam = &H16 Then
+            'Paste Command(Use Clippboard)
+            OpenClipboard(hwnd)
+            Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
+            If hGlobal = 0 Then Exit Sub
+            Dim pTemp = GlobalLock(hGlobal) As PCSTR
+#ifdef UNICODE 'A版ウィンドウプロシージャ用
+            Dim tempSizeA = lstrlenA(pTemp)
+            Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1
+            TempStr = ZeroString(tempSizeW)
+            MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW)
+#else
+            TempStr = ZeroString(lstrlen(pTemp) + 1)
+            lstrcpy(StrPtr(TempStr), pTemp)
+#endif
+            memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length)
+            _PromptSys_InputLen += TempStr.Length
+
+            GlobalUnlock(hGlobal)
+            CloseClipboard()
+        Else
+            _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
+            _PromptSys_InputLen++
+
+            TempStr.ReSize(1)
+            TempStr[0] = wParam As Char
+        End If
+
+        SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
+        PRINT_ToPrompt(TempStr)
+        SendMessage(hwnd, WM_SETFOCUS, 0, 0)
+    End If
+End Sub
+
+Function _PromptWnd_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT
     If (lp And GCS_RESULTSTR) <> 0 Then
         Dim himc = ImmGetContext(hwnd)
@@ -322 +370 @@
         SendMessage(hwnd, WM_SETFOCUS, 0, 0)
 
-        Return 0
+        _PromptWnd_OnImeCompostion = 0
     Else
-        Return DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp)
+        _PromptWnd_OnImeCompostion = DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp)
     End If
 End Function
@@ -332 +380 @@
 
     'Allocate
-    For i=0 To 100
-        _PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255)
-        _PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
-        _PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
+    For i = 0 To 100
+        With _PromptSys_TextLine[i]
+            .Length = 0
+            .Text = _System_calloc(SizeOf (Char) * 255)
+            .CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
+        End With
     Next
 
     'Current Colors initialize
-    _PromptSys_NowTextColor=RGB(255,255,255)
-    _PromptSys_NowBackColor=RGB(0,0,0)
+    _PromptSys_NowTextColor = RGB(255, 255, 255)
+    _PromptSys_NowBackColor = RGB(0, 0, 0)
 
     'Setup
@@ -370 +420 @@
     End With
 
-    _PromptSys_hFont = CreateFontIndirectA(ByVal VarPtr(_PromptSys_LogFont))
+    _PromptSys_hFont = CreateFontIndirectA(_PromptSys_LogFont)
 
     'Critical Section
@@ -381 +431 @@
         .cbSize = Len(wcl)
         .hInstance = GetModuleHandle(0)
-        .style = CS_HREDRAW or CS_VREDRAW' or CS_DBLCLKS
-        .hIcon = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
-        .hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
-        .hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
+        .style = CS_HREDRAW Or CS_VREDRAW' or CS_DBLCLKS
+        .hIcon = LoadImage(0, MAKEINTRESOURCE(IDI_APPLICATION), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
+        .hIconSm = LoadImage(0, MAKEINTRESOURCE(IDI_WINLOGO), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
+        .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
         .lpszClassName = "PROMPT"
         .lpfnWndProc = AddressOf(PromptProc)
@@ -401 +451 @@
     Do
         Dim iResult = GetMessage(msg, 0, 0, 0)
-        If iResult = 0 or iResult = -1 Then Exit Do
+        If iResult = 0 Or iResult = -1 Then Exit Do
         TranslateMessage(msg)
         DispatchMessage(msg)
@@ -410 +460 @@
 
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
-    
-    For i=0 to 100
-        _System_free(_PromptSys_Buffer[i])
-        _System_free(_PromptSys_TextColor[i])
-        _System_free(_PromptSys_BackColor[i])
+
+    For i = 0 to 100
+        _System_free(_PromptSys_TextLine[i].Text)
+        _System_free(_PromptSys_TextLine[i].CharInfo)
     Next
 
@@ -431 +480 @@
 Macro CLS()(num As Long)
     Dim i As Long
-    Dim hOldBrush As HBRUSH
 
     'When parameter was omitted, num is set to 1
-    If num=0 Then num=1
-
-    If num=1 or num=3 Then
+    If num = 0 Then num = 1
+
+    If num = 1 Or num = 3 Then
         'Clear the text screen
         For i = 0 To 100
-            _System_FillChar(_PromptSys_Buffer[i],255,0)
+            With _PromptSys_TextLine[i]
+                .Text[0] = 0 '_System_FillChar(_PromptSys_TextLine[i].Text, -1 As Char, 0)
+                .Length = 0
+            End With
         Next
         With _PromptSys_CurPos
@@ -447 +498 @@
     End If
 
-    If num=2 or num=3 Then
+    If num = 2 Or num = 3 Then
         'Clear the graphics screen
-        hOldBrush=SelectObject(_PromptSys_hMemDC,GetStockObject(BLACK_BRUSH))
-        PatBlt(_PromptSys_hMemDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,PATCOPY)
-        SelectObject(_PromptSys_hMemDC,hOldBrush)
+        Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH))
+        With _PromptSys_ScreenSize
+            PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
+        End With
+        SelectObject(_PromptSys_hMemDC, hOldBrush)
     End If
 
     'Redraw
-    InvalidateRect(_PromptSys_hWnd,ByVal 0,0)
+    InvalidateRect(_PromptSys_hWnd, ByVal 0, 0)
 End Macro
 
 Macro COLOR(TextColorCode As Long)(BackColorCode As Long)
-    _PromptSys_NowTextColor=GetBasicColor(TextColorCode)
-    If BackColorCode=-1 Then
-        _PromptSys_NowBackColor=-1
+    _PromptSys_NowTextColor = GetBasicColor(TextColorCode)
+    If BackColorCode = -1 Then
+        _PromptSys_NowBackColor = -1
     Else
-        _PromptSys_NowBackColor=GetBasicColor(BackColorCode)
+        _PromptSys_NowBackColor = GetBasicColor(BackColorCode)
     End If
 End Macro
@@ -480 +533 @@
 
     'Input by keyboard
-    _PromptSys_InputLen=0
-    SendMessage(_PromptSys_hWnd,WM_SETFOCUS,0,0)
-    While _PromptSys_InputLen<>-1
+    _PromptSys_InputLen = 0
+    SendMessage(_PromptSys_hWnd, WM_SETFOCUS, 0, 0)
+    While _PromptSys_InputLen <> -1
         Sleep(10)
     Wend
-    SendMessage(_PromptSys_hWnd,WM_KILLFOCUS,0,0)
+    SendMessage(_PromptSys_hWnd, WM_KILLFOCUS, 0, 0)
 
     'Set value to variable
@@ -510 +563 @@
 
         i++
-        If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=&h2c Then 'Asc(",")
+        If _System_InputDataPtr[i] = 0 and _PromptSys_InputStr[i2] = &h2c Then 'Asc(",")
             PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
             Goto *InputReStart
-        ElseIf _PromptSys_InputStr[i2]=0 Then
+        ElseIf _PromptSys_InputStr[i2] = 0 Then
             If _System_InputDataPtr[i]<>0 Then
                 PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
@@ -531 +584 @@
 
 Macro LOCATE(x As Long, y As Long)
-    Dim i As Long, i2 As Long
-
-    If x<0 Then x=0
-    If y<0 Then y=0
-    If y>100 Then y=100
+    If x < 0 Then x = 0
+    If y < 0 Then y = 0
+    If y > 100 Then y = 100
     With _PromptSys_CurPos
         .x = x
         .y = y
     End With
-    i=0
-    While _PromptSys_Buffer[y][i]
-        i++
-    Wend
-
+
+    Dim i = _PromptSys_TextLine[y].Length
     If i < x Then
-        _System_FillChar(VarPtr(_PromptSys_Buffer[y][i]), x - i, &h20) 'Asc(" ")
-        For i2 = i To x - 1
-            _PromptSys_BackColor[y][i2] = -1
+        _System_FillChar(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20) 'Asc(" ")
+        Dim i2 As Long
+        For i2 = i To ELM(x)
+            _PromptSys_TextLine[y].CharInfo[i2].BackColor = -1
         Next
+        _PromptSys_TextLine[y].Length = x
     End If
 End Macro
@@ -562 +612 @@
     'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
 
+    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
+
+    Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
     Dim hBrush As HBRUSH
+    If bFill Then
+        hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
+    Else
+        hBrush = GetStockObject(NULL_BRUSH)
+    End If
+
+    Dim hDC = GetDC(_PromptSys_hWnd)
+    Dim hOldPenDC = SelectObject(hDC, hPen)
+    Dim hOldBrushDC = SelectObject(hDC, hBrush)
+    Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
+    Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
+
     Dim radi2 As Long
-    Dim sw As Long
-    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
-
-    Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
-    If bFill Then
-        hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
-    Else
-        hBrush=GetStockObject(NULL_BRUSH)
-    End If
-
-    Dim hDC=GetDC(_PromptSys_hWnd)
-    SelectObject(hDC,hPen)
-    SelectObject(hDC,hBrush)
-    Dim hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
-    Dim hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
-
     If Aspect<1 Then
         radi2=(CDbl(radius)*Aspect) As Long
@@ -591 +640 @@
         Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
     Else
+        Dim sw As Long
         StartPos *=StartPos
         EndPos *=EndPos
@@ -654 +704 @@
     End If
 
-    ReleaseDC(_PromptSys_hWnd,hDC)
-    SelectObject(_PromptSys_hMemDC,hOldPen)
-    SelectObject(_PromptSys_hMemDC,hOldBrush)
+    SelectObject(hDC, hOldPenDC)
+    SelectObject(hDC, hOldBrushDC)
+    ReleaseDC(_PromptSys_hWnd, hDC)
+    SelectObject(_PromptSys_hMemDC, hOldPen)
+    SelectObject(_PromptSys_hMemDC, hOldBrush)
     DeleteObject(hPen)
     If bFill Then DeleteObject(hBrush)
@@ -666 +718 @@
     Dim temp As Long
 
-    If sx=&H80000000 And sy=&H80000000 Then
-        sx=_PromptSys_GlobalPos.x
-        sy=_PromptSys_GlobalPos.y
+    If sx = &H80000000 And sy = &H80000000 Then
+        With _PromptSys_GlobalPos
+            sx = .x
+            sy = .y
+        End With
     End If
 
@@ -694 +748 @@
     Dim hBrush As HBRUSH
     If fType=2 Then
-        hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
+        hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
     Else
-        hBrush=GetStockObject(NULL_BRUSH)
-    End If
-
-    SelectObject(hDC,hPen)
-    SelectObject(hDC,hBrush)
-    Dim hOldPen = SelectObject(_PromptSys_hMemDC,hPen)
-    Dim hOldBrush = SelectObject(_PromptSys_hMemDC,hBrush)
+        hBrush = GetStockObject(NULL_BRUSH)
+    End If
+
+    SelectObject(hDC, hPen)
+    SelectObject(hDC, hBrush)
+    Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
+    Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
 
     Select Case fType
@@ -723 +777 @@
     SelectObject(_PromptSys_hMemDC,hOldBrush)
     DeleteObject(hPen)
-    If fType=2 Then DeleteObject(hBrush)
-
-    _PromptSys_GlobalPos.x=ex
-    _PromptSys_GlobalPos.y=ey
+    If fType = 2 Then DeleteObject(hBrush)
+    With _PromptSys_GlobalPos
+        .x = ex
+        .y = ey
+    End With
 End Macro
 
@@ -733 +788 @@
     'PSet (x,y),ColorCode
 
-    Dim hDC=GetDC(_PromptSys_hWnd)
-    SetPixel(hDC,x,y,GetBasicColor(ColorCode))
-    SetPixel(_PromptSys_hMemDC,x,y,GetBasicColor(ColorCode))
-    ReleaseDC(_PromptSys_hWnd,hDC)
-
-    _PromptSys_GlobalPos.x=x
-    _PromptSys_GlobalPos.y=y
+    Dim hDC = GetDC(_PromptSys_hWnd)
+    SetPixel(hDC, x, y, GetBasicColor(ColorCode))
+    SetPixel(_PromptSys_hMemDC, x, y, GetBasicColor(ColorCode))
+    ReleaseDC(_PromptSys_hWnd, hDC)
+    With _PromptSys_GlobalPos
+        .x = x
+        .y = y
+    End With
 End Macro
 
@@ -746 +802 @@
     'Paint (x,y),BrushColor,LineColor
 
-    Dim hDC As HDC
-    Dim hBrush As HBRUSH, hOldBrush As VoidPtr
-    
-    hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
-
-    hDC=GetDC(_PromptSys_hWnd)
-    SelectObject(hDC,hBrush)
-    hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
-
-    ExtFloodFill(hDC,x,y,GetBasicColor(LineColor),FLOODFILLBORDER)
-    ExtFloodFill(_PromptSys_hMemDC,x,y,GetBasicColor(LineColor),FLOODFILLBORDER)
-
-    ReleaseDC(_PromptSys_hWnd,hDC)
-    SelectObject(_PromptSys_hMemDC,hOldBrush)
+    Dim hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
+
+    Dim hDC = GetDC(_PromptSys_hWnd)
+    Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
+    Dim hOldBrushWndDC = SelectObject(hDC, hBrush)
+
+    ExtFloodFill(hDC, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)
+    ExtFloodFill(_PromptSys_hMemDC, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)
+
+    ReleaseDC(_PromptSys_hWnd, hDC)
+    SelectObject(_PromptSys_hMemDC, hOldBrush)
+    SelectObject(hDC, hOldBrushWndDC)
     DeleteObject(hBrush)
 End Macro
@@ -791 +845 @@
             _PromptSys_KeyChar=0
             i++
-            If i>=length Then
+            If i >= length Then
                 Exit While
             End If