Changeset 121 for Include/basic

Timestamp:

Feb 25, 2007, 12:56:09 AM (18 years ago)

Author:

イグトランス (egtra)

Message:

続#51対応

Location:

Include/basic

Files:

• command.sbp (modified) (1 diff)
• function.sbp (modified) (13 diffs)
• prompt.sbp (modified) (22 diffs)

Include/basic/command.sbp

@@ -212 +212 @@
 
         'データを変数に格納
-        Select Case _System_InputDataType[i]
-            Case _System_Type_Double
-                SetDouble(_System_InputDataPtr[i],Val(buffer))
-            Case _System_Type_Single
-                SetSingle(_System_InputDataPtr[i],Val(buffer))
-            Case _System_Type_Int64,_System_Type_QWord
-                SetQWord(_System_InputDataPtr[i],Val(buffer))
-            Case _System_Type_Long,_System_Type_DWord
-                SetDWord(_System_InputDataPtr[i],Val(buffer))
-            Case _System_Type_Integer,_System_Type_Word
-                SetWord(_System_InputDataPtr[i],Val(buffer))
-            Case _System_Type_Char,_System_Type_Byte
-                SetByte(_System_InputDataPtr[i],Val(buffer))
-
-            Case _System_Type_String
-                Dim pTempStr As *String
-                pTempStr=_System_InputDataPtr[i] As *String
-
-                pTempStr->Length=i3
-                pTempStr->Chars=_System_realloc(pTempStr->Chars,pTempStr->Length+1)
-                memcpy(pTempStr->Chars,buffer.Chars,pTempStr->Length)
-                pTempStr->Chars[pTempStr->Length]=0
-        End Select
-
-        i=i+1
+        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
+
+
+        i++
         If _System_InputDataPtr[i]=0 Then Exit While
     Wend
 End Sub
+
+Function _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
+    Select Case dataType
+        Case _System_Type_Double
+            SetDouble(arg, Val(buf))
+        Case _System_Type_Single
+            SetSingle(arg, Val(buf))
+        Case _System_Type_Int64,_System_Type_QWord
+            SetQWord(arg, Val(buf))
+        Case _System_Type_Long,_System_Type_DWord
+            SetDWord(arg, Val(buf))
+        Case _System_Type_Integer,_System_Type_Word
+            SetWord(arg, Val(buf))
+        Case _System_Type_SByte,_System_Type_Byte
+            SetByte(arg, Val(buf))
+        Case _System_Type_Char
+            SetChar(arg, buf[0])
+        Case _System_Type_String
+            Dim pTempStr As *String
+            pTempStr = arg As *String
+            pTempStr->ReSize(bufLen)
+            memcpy(pTempStr->Chars, buf.Chars, SizeOf (Char) * pTempStr->Length)
+            pTempStr->Chars[pTempStr->Length] = 0
+    End Select
+End Function
 
 Sub PRINT_ToFile(FileNumber As Long, buf As String)

Include/basic/function.sbp

@@ -290 +290 @@
 End Function
 
-Function IsNaN(ByVal x As Double) As BOOL
+Function IsNaN(ByVal x As Double) As Boolean
     Dim p As *DWord
     p = VarPtr(x) As *DWord
@@ -296 +296 @@
     If (p[1] And &H7FF00000) = &H7FF00000 Then
         If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
-            IsNaN = TRUE
+            IsNaN = True
         End If
     End If
@@ -303 +303 @@
 End Function
 
-Function IsInf(x As Double) As BOOL
+Function IsInf(x As Double) As Boolean
     Dim p As *DWord, nan As Double
     p = VarPtr(x) As *DWord
@@ -311 +311 @@
 End Function
 
-Function IsNaNOrInf(x As Double) As BOOL
+Function IsNaNOrInf(x As Double) As Boolean
     IsNaNOrInf = IsFinite(x)
 End Function
 
-Function IsFinite(x As Double) As BOOL
+Function IsFinite(x As Double) As Boolean
     Dim p As *DWord, nan As Double
     p = VarPtr(x) As *DWord
@@ -322 +322 @@
     p[0] = 0
     nan = _System_GetInf(/*x,*/ FALSE)
-    IsNaNOrInf = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
+    IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
 End Function
 
@@ -349 +349 @@
 
 Function Chr$(code As Char) As String
-    Chr$=ZeroString(1)
-    Chr$[0]=code
-End Function
+    Chr$ = ZeroString(1)
+    Chr$[0] = code
+End Function
+
+#ifdef UNICODE
+Function AscW(s As String) As UCSCHAR
+    If s.Length = 0 Then
+        AscW = 0
+    Else
+        If _System_IsSurrogatePair(s[0], s[1]) Then
+            AscW = ((s[0] And &h3FF) As DWord << 10) Or (s[1] And &h3FF)
+        Else
+            AscW = s[0]
+        End If
+    End If
+End Function
+
+Function ChrW(c As UCSCHAR) As String
+    If c <= &hFFFF Then
+        ChrW.ReSize(1)
+        ChrW[0] = c As WCHAR
+    ElseIf c < &h10FFFF Then
+        ChrW.ReSize(2)
+        ChrW[0] = &hD800 Or (c >> 10)
+        ChrW[1] = &hDC00 Or (c And &h3FF)
+    Else
+        ' OutOfRangeException
+    End If
+End Function
+#endif
 
 Function Date$() As String
     Dim st As SYSTEMTIME
-
     GetLocalTime(st)
 
@@ -378 +404 @@
 End Function
 
-Function Hex$(num As DWord) As String
-    Dim length As Long
-    Hex$=ZeroString(8)
-    length=wsprintf(Hex$, "%X", num)
-    Hex$=Left$(Hex$,length)
-End Function
-
-Function Hex$(num As QWord) As String
-    Dim length As Long
-    Hex$=ZeroString(16)
-    length=wsprintf(Hex$, "%X%X", num)
-    Hex$=Left$(Hex$,length)
+Dim _System_HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte
+
+Function Hex$(x As DWord) As String
+    Dim i = 0
+    Hex$ = ZeroString(8)
+    While (x And &hf0000000) = 0
+        x <<= 4
+    Wend
+    While x <> 0
+        Hex$[i] = _System_HexadecimalTable[(x And &hf0000000) >> 28] As Char
+        x <<= 4
+        i++
+    Wend
+    Hex$.ReSize(i)
+End Function
+
+Function Hex$(x As QWord) As String
+    Hex$ = Hex$((x >> 32) As DWord) + Hex$((x And &hffffffff) As DWord)
 End Function
 
@@ -429 +461 @@
 
 Function Left$(buf As String, length As Long) As String
-    Left$=ZeroString(length)
-    memcpy(
-        StrPtr(Left$),
-        StrPtr(buf),
-        length)
+    Left$ = ZeroString(length)
+    memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (Char) * length)
 End Function
 
@@ -458 +487 @@
 
     Mid$=ZeroString(ReadLength)
-    memcpy(StrPtr(Mid$),StrPtr(buf)+StartPos,ReadLength)
+    memcpy(StrPtr(Mid$), VarPtr(buf[StartPos]), SizeOf (Char) * ReadLength)
 End Function
 
@@ -486 +515 @@
     If i>length Then
         Right$=ZeroString(length)
-        memcpy(StrPtr(Right$),StrPtr(buf)+i-length,length)
+        memcpy(StrPtr(Right$), VarPtr(buf[i-length]), SizeOf (Char) * length)
     Else
         Right$=buf
@@ -665 +694 @@
 Function Str$(value As LONG_PTR) As String
     Dim temp[255] As Char
-    wsprintf(temp,"%d",value)
-    Str$=MakeStr(temp)
+#ifdef _WIN64
+    _sntprintf(temp, Len (temp) / SizeOf (Char), "%I64d", value)
+#else
+    _sntprintf(temp, Len (temp) / SizeOf (Char), "%d", value)
+#endif
+    Str$ = temp
 End Function
 
@@ -681 +714 @@
     Dim i As Long
     For i=0 To num-1
-        memcpy(StrPtr(String$)+i*length,StrPtr(buf),length)
+        memcpy(VarPtr(String$[i*length]),StrPtr(buf),SizeOf (Char) * length)
     Next
 End Function
@@ -727 +760 @@
 
     If buf[0]=Asc("&") Then
-        temporary=ZeroString(lstrlen(buf))
-        lstrcpy(temporary,buf)
+        temporary=buf
         TempPtr=StrPtr(temporary)
         CharUpper(TempPtr)

Include/basic/prompt.sbp

@@ -13 +13 @@
 
 'text
-Dim _PromptSys_LogFont As LOGFONT
+Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
 Dim _PromptSys_hFont As HFONT
 Dim _PromptSys_FontSize As SIZE
@@ -21 +21 @@
 Dim _PromptSys_CurPos As POINTAPI
 Dim _PromptSys_Buffer[100] As *Char
-Dim _PromptSys_TextColor[100] As DWordPtr
-Dim _PromptSys_BackColor[100] As DWordPtr
-Dim _PromptSys_NowTextColor As DWord
-Dim _PromptSys_NowBackColor As DWord
+Dim _PromptSys_TextColor[100] As *COLORREF
+Dim _PromptSys_BackColor[100] As *COLORREF
+Dim _PromptSys_NowTextColor As COLORREF
+Dim _PromptSys_NowBackColor As COLORREF
 Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION
 
@@ -38 +38 @@
 
 _PromptSys_bInitFinish=0
-CreateThread(
+CreateThread( _
     0,
     0,
@@ -51 +51 @@
 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
     Dim i As Long, i2 As Long, i3 As Long
-    Dim hOldFont As HFONT
     Dim sz As SIZE
     Dim temporary[2] As Char
 
-    hOldFont=SelectObject(hDC,_PromptSys_hFont)
+    Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
 
     'Scroll
     Dim rc As RECT
-    GetClientRect(_PromptSys_hWnd,rc)
+    GetClientRect(_PromptSys_hWnd, rc)
     While (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy>rc.bottom and _PromptSys_CurPos.y>0
-        HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[0])
-        HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[0])
-        HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[0])
+        _System_free(_PromptSys_Buffer[0])
+        _System_free(_PromptSys_TextColor[0])
+        _System_free(_PromptSys_BackColor[0])
         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_Buffer[i] = _PromptSys_Buffer[i+1]
+            _PromptSys_TextColor[i] = _PromptSys_TextColor[i+1]
+            _PromptSys_BackColor[i] = _PromptSys_BackColor[i+1]
         Next
-        _PromptSys_Buffer[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)
-        _PromptSys_TextColor[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
-        _PromptSys_BackColor[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
+        _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_CurPos.y--
@@ -82 +81 @@
     While i*_PromptSys_FontSize.cy<rc.bottom and i<=100
         If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
-            GetTextExtentPoint32(hDC,_PromptSys_Buffer[i],lstrlen(_PromptSys_Buffer[i]),sz)
+            i3 = lstrlen(_PromptSys_Buffer[i])
+            GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)
+
             BitBlt(hDC,_
                 sz.cx, i*_PromptSys_FontSize.cy, _
@@ -88 +89 @@
                 _PromptSys_hMemDC,sz.cx,i*_PromptSys_FontSize.cy,SRCCOPY)
 
-            i3=lstrlen(_PromptSys_Buffer[i])
-            For i2=0 To i3-1
-                SetTextColor(hDC,_PromptSys_TextColor[i][i2])
-                If _PromptSys_BackColor[i][i2]=-1 Then
-                    SetBkMode(hDC,TRANSPARENT)
+            For i2 = 0 To i3-1
+                SetTextColor(hDC, _PromptSys_TextColor[i][i2])
+                If _PromptSys_BackColor[i][i2] = -1 Then
+                    SetBkMode(hDC, TRANSPARENT)
                 Else
-                    SetBkMode(hDC,OPAQUE)
-                    SetBkColor(hDC,_PromptSys_BackColor[i][i2])
+                    SetBkMode(hDC, OPAQUE)
+                    SetBkColor(hDC, _PromptSys_BackColor[i][i2])
                 End If
 
+                Dim tempLen As Long
                 temporary[0]=_PromptSys_Buffer[i][i2]
 #ifdef UNICODE
@@ -104 +105 @@
                 If IsDBCSLeadByte(temporary[0]) Then
 #endif
-                    temporary[1]=_PromptSys_Buffer[i][i2+1]
-                    temporary[2]=0
+                    temporary[1] = _PromptSys_Buffer[i][i2+1]
+                    temporary[2] = 0
                     i2++
+                    tempLen = 2
                 Else
-                    temporary[1]=0
+                    temporary[1] = 0
+                    tempLen = 1
                 End If
-                TextOut(hDC,i2*_PromptSys_FontSize.cx,i*_PromptSys_FontSize.cy,_
-                    temporary,lstrlen(temporary))
+                With _PromptSys_FontSize
+                    TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen)
+                End With
             Next
         End If
@@ -118 +122 @@
     Wend
 
-    SelectObject(hDC,hOldFont)
+    SelectObject(hDC, hOldFont)
 End Sub
 
 Sub PRINT_ToPrompt(buf As String)
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
-
-        Dim hDC As HDC
+    With _PromptSys_CurPos
         Dim StartLine As Long
-        Dim i2 As Long, i3 As Long
-
-        StartLine=_PromptSys_CurPos.y
-
+        StartLine = .y
         'Addition
-        i2=0
+        Dim i2 = 0 As Long, i3 As Long
         Do
-            If buf[i2]=9 Then   'tab
-                i3=8-(_PromptSys_CurPos.x mod 8)
-
-                FillMemory(_PromptSys_Buffer[_PromptSys_CurPos.y]+_PromptSys_CurPos.x,i3,Asc(" "))
-
+            If buf[i2] = 9 Then 'tab
+                i3 = 8 - (.x And 7) '(.x mod 8)
+                Dim j As Long
+                Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char
+                ' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" "))
+                For j = 0 To ELM(i3)
+                    p[j] = &h20 'Asc(" ")
+                Next
                 i2++
-                _PromptSys_CurPos.x += i3
+                .x += i3
                 Continue
             End If
 
-            If buf[i2]=13 and buf[i2+1]=10 Then '\r\n
+            If buf[i2] = 13 and buf[i2+1] = 10 Then '\r\n
                 i2 += 2
-                _PromptSys_CurPos.y++
-                _PromptSys_CurPos.x=0
+                .y++
+                .x = 0
                 Continue
             End If
 
-            If buf[i2]=0 Then Exit Do
-            _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=buf[i2]
-            _PromptSys_TextColor[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowTextColor
-            _PromptSys_BackColor[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowBackColor
+            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++
-            _PromptSys_CurPos.x++
+            .x++
         Loop
-
         'Draw the text buffer added
-        hDC=GetDC(_PromptSys_hWnd)
-        DrawPromptBuffer(hDC,StartLine,_PromptSys_CurPos.y)
-        ReleaseDC(_PromptSys_hWnd,hDC)
-
+        Dim hDC = GetDC(_PromptSys_hWnd)
+        DrawPromptBuffer(hDC, StartLine, .y)
+        ReleaseDC(_PromptSys_hWnd, hDC)
+    End With
     LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
 End Sub
@@ -172 +174 @@
     Dim ps As PAINTSTRUCT
     Dim TempStr As String
-    Dim temporary[255] As Byte
     Dim CompForm As COMPOSITIONFORM
-    Dim hGlobal As HGLOBAL
 
     Select Case message
         Case WM_CREATE
-            hDC=GetDC(hWnd)
-            _PromptSys_hBitmap=CreateCompatibleBitmap(hDC,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy)
-            _PromptSys_hMemDC=CreateCompatibleDC(hDC)
-            SelectObject(_PromptSys_hMemDC,_PromptSys_hBitmap)
+            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 As HBRUSH
-            hOldBrush=SelectObject(_PromptSys_hMemDC,GetStockObject(BLACK_BRUSH))
-            PatBlt(_PromptSys_hMemDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,PATCOPY)
-            SelectObject(_PromptSys_hMemDC,hOldBrush)
-
-            Dim hOldFont As HFONT
+            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
-            hOldFont=SelectObject(_PromptSys_hMemDC,_PromptSys_hFont)
-            GetTextExtentPoint32(_PromptSys_hMemDC," ",1,_PromptSys_FontSize)
-            GetTextMetrics(_PromptSys_hMemDC,tm)
-            SelectObject(_PromptSys_hMemDC,hOldFont)
-            _PromptSys_FontSize.cy=tm.tmHeight
+            Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
+            GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize)
+            GetTextMetrics(_PromptSys_hMemDC, tm)
+            SelectObject(_PromptSys_hMemDC, hOldFont)
+            _PromptSys_FontSize.cy = tm.tmHeight
 
             ReleaseDC(hWnd,hDC)
         Case WM_PAINT
-            hDC=BeginPaint(hWnd,ps)
-            BitBlt(hDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,_PromptSys_hMemDC,0,0,SRCCOPY)
-            DrawPromptBuffer(hDC,-1,0)
-            EndPaint(hWnd,ps)
-
-            _PromptSys_bInitFinish=1
+            hDC = BeginPaint(hWnd,ps)
+            With _PromptSys_ScreenSize
+                BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
+            End With
+            DrawPromptBuffer(hDC, -1, 0)
+            EndPaint(hWnd, ps)
+
+            _PromptSys_bInitFinish = TRUE
         Case WM_SETFOCUS
             If _PromptSys_InputLen<>-1 Then
-                hIMC=ImmGetContext(hWnd)
+                hIMC = ImmGetContext(hWnd)
                 If hIMC Then
-                    CompForm.dwStyle=CFS_POINT
-                    CompForm.ptCurrentPos.x=_PromptSys_CurPos.x*_PromptSys_FontSize.cx
-                    CompForm.ptCurrentPos.y=_PromptSys_CurPos.y*_PromptSys_FontSize.cy
-                    ImmSetCompositionWindow(hIMC,CompForm)
-                    ImmSetCompositionFont(hIMC,_PromptSys_LogFont)
+                    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)
+                ImmReleaseContext(hWnd, hIMC)
 
                 CreateCaret(hWnd,NULL,9,6)
@@ -230 +236 @@
             End If
         Case WM_CHAR
-            If _PromptSys_InputLen<>-1 Then
-                If wParam=VK_BACK Then
+            If _PromptSys_InputLen <> -1 Then
+                If wParam = VK_BACK Then
                     If _PromptSys_InputLen Then
-                        _PromptSys_InputLen=_PromptSys_InputLen-1
-                        _PromptSys_InputStr[_PromptSys_InputLen]=0
-
-                        _PromptSys_CurPos.x=_PromptSys_CurPos.x-1
-                        _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=0
+                        _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
+                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)
-                    hGlobal=GetClipboardData(CF_TEXT)
-                    If hGlobal=0 Then PromptProc=0:Exit Function
-                    Dim pTemp=GlobalLock(hGlobal) As *Byte
-#ifdef UNICODE
+                    Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
+                    If hGlobal = 0 Then Return 0
+                    Dim pTemp = GlobalLock(hGlobal) As PCSTR
+#ifdef UNICODE 'A版ウィンドウプロシージャ用
                     Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1
-                    TempStr=ZeroString(tempSizeW)
+                    TempStr = ZeroString(tempSizeW)
                     MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW)
 #else
-                    TempStr=ZeroString(lstrlen(pTemp)+1)
-                    lstrcpy(StrPtr(TempStr),pTemp)
+                    TempStr = ZeroString(lstrlen(pTemp) + 1)
+                    lstrcpy(StrPtr(TempStr), pTemp)
 #endif
-                    lstrcpy((VarPtr(_PromptSys_InputStr[0])+_PromptSys_InputLen) As *Byte,pTemp)
-                    _PromptSys_InputLen=_PromptSys_InputLen+lstrlen(pTemp)
+                    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_InputStr[_PromptSys_InputLen] = wParam As Byte
                     _PromptSys_InputLen++
 
-                    temporary[0]=wParam As Byte
-                    temporary[1]=0
-                    TempStr=temporary
+                    TempStr.ReSize(1)
+                    TempStr[0] = wParam As Char
                 End If
 
-                SendMessage(hWnd,WM_KILLFOCUS,0,0)
+                SendMessage(hWnd, WM_KILLFOCUS, 0, 0)
                 PRINT_ToPrompt(TempStr)
-                SendMessage(hWnd,WM_SETFOCUS,0,0)
+                SendMessage(hWnd, WM_SETFOCUS, 0, 0)
             End If
         Case WM_DESTROY
@@ -292 +297 @@
     'Allocate
     For i=0 To 100
-        _PromptSys_Buffer[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)
-        _PromptSys_TextColor[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
-        _PromptSys_BackColor[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
+        _PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255)
+        _PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
+        _PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
     Next
 
@@ -306 +311 @@
 
     'LogFont initialize
-    _PromptSys_LogFont.lfHeight=-16
-    _PromptSys_LogFont.lfWidth=0
-    _PromptSys_LogFont.lfEscapement=0
-    _PromptSys_LogFont.lfOrientation=0
-    _PromptSys_LogFont.lfWeight=0
-    _PromptSys_LogFont.lfItalic=0
-    _PromptSys_LogFont.lfUnderline=0
-    _PromptSys_LogFont.lfStrikeOut=0
-    _PromptSys_LogFont.lfCharSet=SHIFTJIS_CHARSET
-    _PromptSys_LogFont.lfOutPrecision=OUT_DEFAULT_PRECIS
-    _PromptSys_LogFont.lfClipPrecision=CLIP_DEFAULT_PRECIS
-    _PromptSys_LogFont.lfQuality=DEFAULT_QUALITY
-    _PromptSys_LogFont.lfPitchAndFamily=FIXED_PITCH
-    lstrcpy(_PromptSys_LogFont.lfFaceName,"ＭＳ 明朝")
-
-    _PromptSys_hFont=CreateFontIndirect(_PromptSys_LogFont)
+    With _PromptSys_LogFont
+        .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, "ＭＳ 明朝")
+    End With
+
+    _PromptSys_hFont = CreateFontIndirect(ByVal VarPtr(_PromptSys_LogFont))
 
     'Critical Section
@@ -338 +345 @@
     wcl.lpfnWndProc=AddressOf(PromptProc)
     wcl.hbrBackground=GetStockObject(BLACK_BRUSH)
-    RegisterClassEx(wcl)
+    Dim atom = RegisterClassEx(wcl)
 
     'Create Prompt Window
-    _PromptSys_hWnd=CreateWindowEx(WS_EX_CLIENTEDGE,"PROMPT","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,GetModuleHandle(0),0)
     ShowWindow(_PromptSys_hWnd,SW_SHOW)
     UpdateWindow(_PromptSys_hWnd)
@@ -353 +360 @@
     Loop
 
+    '強制的に終了する
+    ExitProcess(0)
+
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
-        For i=0 to 100
-            HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[i])
-            HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[i])
-            HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[i])
-        Next
-
-        '強制的に終了する
-        ExitProcess(0)
+    
+    For i=0 to 100
+        _System_free(_PromptSys_Buffer[i])
+        _System_free(_PromptSys_TextColor[i])
+        _System_free(_PromptSys_BackColor[i])
+    Next
 
     LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
@@ -432 +440 @@
 
     'Set value to variable
-    i=0
-    i2=0
-    buf=ZeroString(lstrlen(_PromptSys_InputStr))
+    i = 0
+    i2 = 0
+    buf = ZeroString(lstrlen(_PromptSys_InputStr))
     While 1
-        i3=0
+        i3 = 0
         While 1
-            If _PromptSys_InputStr[i2]=Asc(",") Then
-                buf.Chars[i3]=0
+            If _PromptSys_InputStr[i2] = &h2c Then
+                buf.Chars[i3] = 0
                 Exit While
             End If
 
-            buf.Chars[i3]=_PromptSys_InputStr[i2]
-
-            If _PromptSys_InputStr[i2]=0 Then Exit While
+            buf.Chars[i3] = _PromptSys_InputStr[i2]
+
+            If _PromptSys_InputStr[i2] = 0 Then Exit While
 
             i2++
@@ -451 +459 @@
         Wend
 
-        Select Case _System_InputDataType[i]
-            Case _System_Type_Double
-                SetDouble(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_Single
-                SetSingle(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_Int64,_System_Type_QWord
-                SetQWord(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_Long,_System_Type_DWord
-                SetDWord(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_Integer,_System_Type_Word
-                SetWord(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_SByte,_System_Type_Byte
-                SetByte(_System_InputDataPtr[i],Val(buf))
-            Case _System_Type_Char
-#ifdef UNICODE
-                SetWord(_System_InputDataPtr[i], buf[0])
-#else
-                SetByte(_System_InputDataPtr[i], buf[0])
-#endif
-            Case _System_Type_String
-            *INPUT_FromPrompt_Type_String
-                Dim pTempStr As *String
-                pTempStr=_System_InputDataPtr[i] As *String
-                pTempStr->ReSize(i3)
-                memcpy(pTempStr->Chars, buf.Chars, pTempStr->Length)
-                pTempStr->Chars[pTempStr->Length] = 0
-            Case 13
-                Goto *INPUT_FromPrompt_Type_String
-        End Select
+        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)
 
         i++
-        If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=Asc(",") Then
+        If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=&h2c Then 'Asc(",")
             PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
             Goto *InputReStart
@@ -494 +474 @@
         End If
 
-        i2=i2+1
+        i2++
     Wend
 End Sub
@@ -534 +514 @@
     'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
 
-    Dim hDC As HDC
-    Dim hPen As HPEN, hOldPen As VoidPtr
-    Dim hBrush As HBRUSH, hOldBrush As VoidPtr
+    Dim hBrush As HBRUSH
     Dim radi2 As Long
     Dim sw As Long
     Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
 
-    hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
+    Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
     If bFill Then
         hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
@@ -548 +526 @@
     End If
 
-    hDC=GetDC(_PromptSys_hWnd)
+    Dim hDC=GetDC(_PromptSys_hWnd)
     SelectObject(hDC,hPen)
     SelectObject(hDC,hBrush)
-    hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
-    hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
+    Dim hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
+    Dim hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
 
     If Aspect<1 Then
@@ -664 +642 @@
     End If
 
-    Dim hDC As HDC
-    Dim hPen As HPEN, hOldPen As VoidPtr
-    Dim hBrush As HBRUSH, hOldBrush As VoidPtr
-
-    hDC=GetDC(_PromptSys_hWnd)
-    hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
+    Dim hDC = GetDC(_PromptSys_hWnd)
+    Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
+    Dim hBrush As HBRUSH
     If fType=2 Then
         hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
@@ -678 +653 @@
     SelectObject(hDC,hPen)
     SelectObject(hDC,hBrush)
-    hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
-    hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
+    Dim hOldPen = SelectObject(_PromptSys_hMemDC,hPen)
+    Dim hOldBrush = SelectObject(_PromptSys_hMemDC,hBrush)
 
     Select Case fType
@@ -710 +685 @@
     'PSet (x,y),ColorCode
 
-    Dim hDC As HDC
-
-    hDC=GetDC(_PromptSys_hWnd)
+    Dim hDC=GetDC(_PromptSys_hWnd)
     SetPixel(hDC,x,y,GetBasicColor(ColorCode))
     SetPixel(_PromptSys_hMemDC,x,y,GetBasicColor(ColorCode))