Changeset 121


Ignore:
Timestamp:
Feb 25, 2007, 12:56:09 AM (17 years ago)
Author:
イグトランス (egtra)
Message:

#51対応

Location:
Include
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • Include/Classes/System/String.ab

    r119 r121  
    55
    66    Sub String()
    7         Chars = _System_calloc(1)
     7        Chars = _System_calloc(SizeOf (Char) * 1)
    88        m_Length = 0
    99    End Sub
     
    1919    End Sub
    2020
    21 /*
    2221    Sub String(length As Long)
     22        String()
    2323        ReSize(length)
    2424    End Sub
    25 */
     25
    2626    Sub String(initChar As Char, length As Long)
    2727        ReSize(length, initChar)
     
    2929
    3030    Sub ~String()
    31         _System_free(Chars)
     31'       _System_free(Chars)
    3232        Chars = 0
    3333#ifdef _DEBUG
     
    3636    End Sub
    3737
    38     Function Length() As Long
     38    Const Function Length() As Long
    3939        Return m_Length
    4040    End Function
     
    5252    End Sub
    5353
    54     Function Operator[] (n As Long) As Char
     54    Const Function Operator[] (n As Long) As Char
    5555        Return Chars[n]
    5656    End Function
     
    6060    End Sub
    6161
    62     Function Operator+ (lpszText As *Char) As String
     62    Const Function Operator + (lpszText As *Char) As String
    6363        Return Concat(lpszText, lstrlen(lpszText))
    6464    End Function
    6565
    66     Function Operator+ (ByRef objString As String) As String
     66    Const Function Operator + (ByRef objString As String) As String
    6767        Return Concat(objString, objString.m_Length)
    6868    End Function
    6969
    70     Function Operator& (lpszText As *Char) As String
    71         Dim tempString As String
    72         tempString=This+lpszText
     70    Const Function Operator & (lpszText As *Char) As String
     71        Dim tempString = This + lpszText
    7372        Return tempString
    7473    End Function
    7574
    76     Function Operator& (ByRef objString As String) As String
    77         Dim tempString As String
    78         tempString=This+objString
     75    Const Function Operator & (ByRef objString As String) As String
     76        Dim tempString = This + objString
    7977        Return tempString
    8078    End Function
     
    178176            oldLength = m_Length
    179177            If AllocStringBuffer(allocLength) <> 0 Then
    180                 ZeroMemory(Chars + oldLength, m_Length - oldLength + 1)
     178                ZeroMemory(VarPtr(Chars[oldLength]), SizeOf (Char) * (m_Length - oldLength + 1))
    181179            End If
    182180        Else
     
    193191            oldLength = m_Length
    194192            If AllocStringBuffer(allocLength) <> 0 Then
    195                 FillMemory(Chars + oldLength, m_Length - oldLength, c)
     193                Dim p = VarPtr(Chars[oldLength]) As *Char
     194                Dim fillLen = m_Length - oldLength
     195                Dim i As Long
     196                For i = 0 To ELM(fillLen)
     197                    p[i] = c
     198                Next
    196199            End If
    197200        Else
     
    201204    End Sub
    202205
    203     Sub Assign(lpszText As *Char, textLength As Long)
    204         If lpszText = Chars Then Exit Sub
     206    Sub Assign(text As *Char, textLength As Long)
     207        If text = Chars Then Exit Sub
    205208        If AllocStringBuffer(textLength) <> 0 Then
    206             memcpy(Chars, lpszText, textLength)
     209            memcpy(Chars, text, SizeOf (Char) * textLength)
    207210            Chars[m_Length] = 0
    208211        End If     
     
    213216    End Sub
    214217
    215     Sub Assign(lpszText As *Char)
    216         If lpszText Then
    217             Assign(lpszText, lstrlen(lpszText))
     218    Sub Assign(text As *Char)
     219        If text Then
     220            Assign(text, lstrlen(text))
    218221        Else
    219222            'Chars=_System_realloc(Chars,1)
     
    223226    End Sub
    224227
    225     Sub Append(lpszText As *Char, textLength As Long)
     228    Sub Append(text As *Char, textLength As Long)
    226229        Dim prevLen As Long
    227230        prevLen = m_Length
    228231        If AllocStringBuffer(m_Length + textLength) <> 0 Then
    229             memcpy(Chars + prevLen, lpszText, textLength)
     232            memcpy(VarPtr(Chars[prevLen]), text, SizeOf (Char) * textLength)
    230233            Chars[m_Length] = 0
    231234        End If
     
    244247        With tempString
    245248            .AllocStringBuffer(This.m_Length + textLength)
    246             memcpy(.Chars, This.Chars, This.m_Length)
    247             memcpy(.Chars + This.m_Length, lpszText, textLength)
     249            memcpy(.Chars, This.Chars, SizeOf (Char) * This.m_Length)
     250            memcpy(VarPtr(.Chars[This.m_Length]), lpszText, SizeOf (Char) * textLength)
    248251            .Chars[.m_Length] = 0
    249252        End With
     
    345348    End Function
    346349
    347     Function Insert(startIndex As Long, lpszText As *Char) As Long
     350    Function Insert(startIndex As Long, text As *Char) As Long
    348351        Dim length As Long
    349         length = lstrlen(lpszText)
     352        length = lstrlen(text)
    350353
    351354        If startIndex < 0 Or startIndex > m_Length Then Return -1
    352355
    353356        Dim newChars As *Char
    354         newChars = _System_malloc(length + m_Length + 1)
     357        newChars = _System_malloc(SizeOf (Char) * (length + m_Length + 1))
    355358        If newChars = 0 Then Return -1
    356359
    357         memcpy(newChars, Chars, startIndex)
    358         memcpy(newChars + startIndex, lpszText, length)
    359         memcpy(newChars + startIndex + length, Chars + startIndex, m_Length - startIndex + 1)
     360        memcpy(newChars, Chars, SizeOf (Char) * startIndex)
     361        memcpy(VarPtr(newChars[startIndex]), text, SizeOf (Char) * length)
     362        memcpy(VarPtr(newChars[startIndex + length]), VarPtr(Chars[startIndex]), SizeOf (Char) * (m_Length - startIndex + 1))
    360363
    361364        _System_free(Chars)
     
    375378        Dim temp As String
    376379        temp.AllocStringBuffer(length)
    377         memcpy(temp.Chars, VarPtr(Chars[startIndex]), length)
     380        memcpy(temp.Chars, VarPtr(Chars[startIndex]), SizeOf (Char) * length)
    378381        Chars[m_Length] = 0
    379382        Return temp
     
    392395
    393396        Dim newChars As *Char
    394         newChars = _System_malloc(m_Length - count + 1)
     397        newChars = _System_malloc(SizeOf (Char) * (m_Length - count + 1))
    395398        If newChars = 0 Then Return -1
    396399
    397         memcpy(newChars, Chars, startIndex)
    398         memcpy(newChars + startIndex, Chars + startIndex + count, m_Length - startIndex - count)
     400        memcpy(newChars, Chars, SizeOf (Char) * startIndex)
     401        memcpy(VarPtr(newChars[startIndex]), VarPtr(Chars[startIndex + count]), SizeOf (Char) * (m_Length - startIndex - count))
    399402        newChars[m_Length - count] = 0
    400403
     
    479482            Return 0
    480483        ElseIf textLength > m_Length Then
    481             AllocStringBuffer = _System_realloc(Chars, textLength + 1)
     484            AllocStringBuffer = _System_realloc(Chars, SizeOf(Char) * (textLength + 1))
    482485            If AllocStringBuffer <> 0 Then
    483486                m_Length = textLength
  • Include/api_gdi.sbp

    r119 r121  
    542542
    543543Declare Function ExtSelectClipRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, fnMode As Long) As Long
     544Declare Function ExtTextOutA Lib "gdi32" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCSTR, cbCount As Long, pDx As *Long) As Long
     545Declare Function ExtTextOutW Lib "gdi32" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCWSTR, cbCount As Long, pDx As *Long) As Long
     546#ifdef UNICODE
     547Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutW" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCTSTR, cbCount As Long, pDx As *Long) As Long
     548#else
     549Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCTSTR, cbCount As Long, pDx As *Long) As Long
     550#endif
    544551Declare Function FillPath Lib "gdi32" (hdc As HDC) As Long
    545552Declare Function FillRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH) As Long
  • Include/api_system.sbp

    r119 r121  
    326326Declare Function InterlockedDecrement Lib "kernel32" (ByRef lpAddend As Long) As Long
    327327Declare Function InterlockedExchange Lib "kernel32" (ByRef Target As Long, Value As Long) As Long
    328 Declare Function InterlockedCompareExchange Lib "kernel32" (Destination As *VoidPtr, Exchange As VoidPtr, Comperand As VoidPtr) As VoidPtr
     328Declare Function InterlockedCompareExchange Lib "kernel32" (ByRef Destination As Long, Exchange As Long, Comperand As Long) As Long
    329329Declare Function InterlockedExchangeAdd Lib "kernel32" (ByRef Addend As Long, Value As Long) As Long
    330330#ifdef _WIN64
    331 Declare Function InterlockedCompareExchangePointer Lib "kernel32" (Destination As *VoidPtr, Exchange As VoidPtr, Comperand As VoidPtr) As VoidPtr
     331Declare Function InterlockedCompareExchangePointer Lib "kernel32" (ByRef Destination As VoidPtr, Exchange As VoidPtr, Comperand As VoidPtr) As VoidPtr
     332Declare Function InterlockedExchangePointer Lib "kernel32" (ByRef Target As VoidPtr, Value As VoidPtr) As VoidPtr
    332333#else
     334Declare Function InterlockedCompareExchangePointer Lib "kernel32" Alias "InterlockedCompareExchange" (ByRef Destination As VoidPtr, Exchange As VoidPtr, Comperand As VoidPtr) As VoidPtr
    333335Declare Function InterlockedExchangePointer Lib "kernel32" Alias "InterlockedExchange" (ByRef Target As VoidPtr, Value As VoidPtr) As VoidPtr
    334336#endif
     
    737739Declare Sub InitializeCriticalSection Lib "kernel32" (ByRef lpCriticalSection As CRITICAL_SECTION)
    738740Declare Function IsBadReadPtr Lib "kernel32" (lp As VoidPtr, ucb As ULONG_PTR) As BOOL
    739 Declare Function IsBadWritePtr Lib "kernel32" (lp As VoidPtr, ucb As DWord) As BOOL
     741Declare Function IsBadWritePtr Lib "kernel32" (lp As VoidPtr, ucb As ULONG_PTR) As BOOL
    740742Declare Function IsDBCSLeadByte Lib "kernel32" (TestChar As Byte) As BOOL
    741743
     
    775777Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (pLibFileName As PCSTR, hFile As HANDLE, dwFlags As DWord) As HINSTANCE
    776778
    777 Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (lpString1 As BytePtr, lpString2 As BytePtr) As BytePtr
    778 Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (lpString1 As BytePtr, lpString2 As BytePtr) As Long
    779 Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (lpString1 As BytePtr, lpString2 As BytePtr) As Long
    780 Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As BytePtr, lpString2 As BytePtr) As BytePtr
    781 Declare Function lstrlenA Lib "kernel32" (lpString As LPSTR) As Long
    782 Declare Function lstrlenW Lib "kernel32" (lpString As LPWSTR) As Long
     779Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (pString1 As PSTR, pString2 As PCSTR) As PSTR
     780Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (pString1 As PCSTR, pString2 As PCSTR) As Long
     781Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (pString1 As PCSTR, pString2 As PCSTR) As Long
     782Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (pString1 As PSTR, pString2 As PCSTR) As PSTR
     783Declare Function lstrlenA Lib "kernel32" (pString As PCSTR) As Long
     784Declare Function lstrlenW Lib "kernel32" (pString As PCWSTR) As Long
    783785#ifdef UNICODE
    784 Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As *Char) As Long
     786Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (lpString As PCTSTR) As Long
    785787#else
    786 Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As *Char) As Long
     788Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As PCTSTR) As Long
    787789#endif
    788790Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (pDest As VoidPtr, pSrc As VoidPtr, length As SIZE_T)
     
    804806Const CP_UTF8       = 65001  'UTF-8 translation
    805807
    806 Declare Function MultiByteToWideChar Lib "kernel32" (CodePage As DWord, dwFlags As DWord, lpMultiByteStr As BytePtr, cchMultiByte As Long, lpWideCharStr As WordPtr, cchWideChar As Long) As Long
     808Declare Function MultiByteToWideChar Lib "kernel32" (CodePage As DWord, dwFlags As DWord, pMultiByteStr As PCSTR, cchMultiByte As Long, pWideCharStr As PWSTR, cchWideChar As Long) As Long
    807809
    808810Declare Function OpenEvent Lib "kernel32" Alias "OpenEventA" (dwDesiredAccess As DWord, bInheritHandle As BOOL, pName As PCSTR) As HANDLE
  • Include/basic.sbp

    r79 r121  
    7979End Function
    8080
     81Sub SetChar(p As *Char, c As Char)
     82    p[0] = c
     83End Sub
     84
     85Function GetChar(p As *Char) As Char
     86    GetChar = p[0]
     87End Function
     88
    8189TypeDef SIZE_T = ULONG_PTR
    8290TypeDef SSIZE_T = LONG_PTR
     
    8795' Specify elements number
    8896'--------------------------
    89 Const ELM(n) = n - 1
     97Const ELM(n) = (n - 1)
    9098
    9199#include <windows.sbp>
  • Include/basic/command.sbp

    r119 r121  
    212212
    213213        'データを変数に格納
    214         Select Case _System_InputDataType[i]
    215             Case _System_Type_Double
    216                 SetDouble(_System_InputDataPtr[i],Val(buffer))
    217             Case _System_Type_Single
    218                 SetSingle(_System_InputDataPtr[i],Val(buffer))
    219             Case _System_Type_Int64,_System_Type_QWord
    220                 SetQWord(_System_InputDataPtr[i],Val(buffer))
    221             Case _System_Type_Long,_System_Type_DWord
    222                 SetDWord(_System_InputDataPtr[i],Val(buffer))
    223             Case _System_Type_Integer,_System_Type_Word
    224                 SetWord(_System_InputDataPtr[i],Val(buffer))
    225             Case _System_Type_Char,_System_Type_Byte
    226                 SetByte(_System_InputDataPtr[i],Val(buffer))
    227 
    228             Case _System_Type_String
    229                 Dim pTempStr As *String
    230                 pTempStr=_System_InputDataPtr[i] As *String
    231 
    232                 pTempStr->Length=i3
    233                 pTempStr->Chars=_System_realloc(pTempStr->Chars,pTempStr->Length+1)
    234                 memcpy(pTempStr->Chars,buffer.Chars,pTempStr->Length)
    235                 pTempStr->Chars[pTempStr->Length]=0
    236         End Select
    237 
    238         i=i+1
     214        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
     215
     216
     217        i++
    239218        If _System_InputDataPtr[i]=0 Then Exit While
    240219    Wend
    241220End Sub
     221
     222Function _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
     223    Select Case dataType
     224        Case _System_Type_Double
     225            SetDouble(arg, Val(buf))
     226        Case _System_Type_Single
     227            SetSingle(arg, Val(buf))
     228        Case _System_Type_Int64,_System_Type_QWord
     229            SetQWord(arg, Val(buf))
     230        Case _System_Type_Long,_System_Type_DWord
     231            SetDWord(arg, Val(buf))
     232        Case _System_Type_Integer,_System_Type_Word
     233            SetWord(arg, Val(buf))
     234        Case _System_Type_SByte,_System_Type_Byte
     235            SetByte(arg, Val(buf))
     236        Case _System_Type_Char
     237            SetChar(arg, buf[0])
     238        Case _System_Type_String
     239            Dim pTempStr As *String
     240            pTempStr = arg As *String
     241            pTempStr->ReSize(bufLen)
     242            memcpy(pTempStr->Chars, buf.Chars, SizeOf (Char) * pTempStr->Length)
     243            pTempStr->Chars[pTempStr->Length] = 0
     244    End Select
     245End Function
    242246
    243247Sub PRINT_ToFile(FileNumber As Long, buf As String)
  • Include/basic/function.sbp

    r119 r121  
    290290End Function
    291291
    292 Function IsNaN(ByVal x As Double) As BOOL
     292Function IsNaN(ByVal x As Double) As Boolean
    293293    Dim p As *DWord
    294294    p = VarPtr(x) As *DWord
     
    296296    If (p[1] And &H7FF00000) = &H7FF00000 Then
    297297        If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
    298             IsNaN = TRUE
     298            IsNaN = True
    299299        End If
    300300    End If
     
    303303End Function
    304304
    305 Function IsInf(x As Double) As BOOL
     305Function IsInf(x As Double) As Boolean
    306306    Dim p As *DWord, nan As Double
    307307    p = VarPtr(x) As *DWord
     
    311311End Function
    312312
    313 Function IsNaNOrInf(x As Double) As BOOL
     313Function IsNaNOrInf(x As Double) As Boolean
    314314    IsNaNOrInf = IsFinite(x)
    315315End Function
    316316
    317 Function IsFinite(x As Double) As BOOL
     317Function IsFinite(x As Double) As Boolean
    318318    Dim p As *DWord, nan As Double
    319319    p = VarPtr(x) As *DWord
     
    322322    p[0] = 0
    323323    nan = _System_GetInf(/*x,*/ FALSE)
    324     IsNaNOrInf = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
     324    IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
    325325End Function
    326326
     
    349349
    350350Function Chr$(code As Char) As String
    351     Chr$=ZeroString(1)
    352     Chr$[0]=code
    353 End Function
     351    Chr$ = ZeroString(1)
     352    Chr$[0] = code
     353End Function
     354
     355#ifdef UNICODE
     356Function AscW(s As String) As UCSCHAR
     357    If s.Length = 0 Then
     358        AscW = 0
     359    Else
     360        If _System_IsSurrogatePair(s[0], s[1]) Then
     361            AscW = ((s[0] And &h3FF) As DWord << 10) Or (s[1] And &h3FF)
     362        Else
     363            AscW = s[0]
     364        End If
     365    End If
     366End Function
     367
     368Function ChrW(c As UCSCHAR) As String
     369    If c <= &hFFFF Then
     370        ChrW.ReSize(1)
     371        ChrW[0] = c As WCHAR
     372    ElseIf c < &h10FFFF Then
     373        ChrW.ReSize(2)
     374        ChrW[0] = &hD800 Or (c >> 10)
     375        ChrW[1] = &hDC00 Or (c And &h3FF)
     376    Else
     377        ' OutOfRangeException
     378    End If
     379End Function
     380#endif
    354381
    355382Function Date$() As String
    356383    Dim st As SYSTEMTIME
    357 
    358384    GetLocalTime(st)
    359385
     
    378404End Function
    379405
    380 Function Hex$(num As DWord) As String
    381     Dim length As Long
    382     Hex$=ZeroString(8)
    383     length=wsprintf(Hex$, "%X", num)
    384     Hex$=Left$(Hex$,length)
    385 End Function
    386 
    387 Function Hex$(num As QWord) As String
    388     Dim length As Long
    389     Hex$=ZeroString(16)
    390     length=wsprintf(Hex$, "%X%X", num)
    391     Hex$=Left$(Hex$,length)
     406Dim _System_HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte
     407
     408Function Hex$(x As DWord) As String
     409    Dim i = 0
     410    Hex$ = ZeroString(8)
     411    While (x And &hf0000000) = 0
     412        x <<= 4
     413    Wend
     414    While x <> 0
     415        Hex$[i] = _System_HexadecimalTable[(x And &hf0000000) >> 28] As Char
     416        x <<= 4
     417        i++
     418    Wend
     419    Hex$.ReSize(i)
     420End Function
     421
     422Function Hex$(x As QWord) As String
     423    Hex$ = Hex$((x >> 32) As DWord) + Hex$((x And &hffffffff) As DWord)
    392424End Function
    393425
     
    429461
    430462Function Left$(buf As String, length As Long) As String
    431     Left$=ZeroString(length)
    432     memcpy(
    433         StrPtr(Left$),
    434         StrPtr(buf),
    435         length)
     463    Left$ = ZeroString(length)
     464    memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (Char) * length)
    436465End Function
    437466
     
    458487
    459488    Mid$=ZeroString(ReadLength)
    460     memcpy(StrPtr(Mid$),StrPtr(buf)+StartPos,ReadLength)
     489    memcpy(StrPtr(Mid$), VarPtr(buf[StartPos]), SizeOf (Char) * ReadLength)
    461490End Function
    462491
     
    486515    If i>length Then
    487516        Right$=ZeroString(length)
    488         memcpy(StrPtr(Right$),StrPtr(buf)+i-length,length)
     517        memcpy(StrPtr(Right$), VarPtr(buf[i-length]), SizeOf (Char) * length)
    489518    Else
    490519        Right$=buf
     
    665694Function Str$(value As LONG_PTR) As String
    666695    Dim temp[255] As Char
    667     wsprintf(temp,"%d",value)
    668     Str$=MakeStr(temp)
     696#ifdef _WIN64
     697    _sntprintf(temp, Len (temp) / SizeOf (Char), "%I64d", value)
     698#else
     699    _sntprintf(temp, Len (temp) / SizeOf (Char), "%d", value)
     700#endif
     701    Str$ = temp
    669702End Function
    670703
     
    681714    Dim i As Long
    682715    For i=0 To num-1
    683         memcpy(StrPtr(String$)+i*length,StrPtr(buf),length)
     716        memcpy(VarPtr(String$[i*length]),StrPtr(buf),SizeOf (Char) * length)
    684717    Next
    685718End Function
     
    727760
    728761    If buf[0]=Asc("&") Then
    729         temporary=ZeroString(lstrlen(buf))
    730         lstrcpy(temporary,buf)
     762        temporary=buf
    731763        TempPtr=StrPtr(temporary)
    732764        CharUpper(TempPtr)
  • Include/basic/prompt.sbp

    r119 r121  
    1313
    1414'text
    15 Dim _PromptSys_LogFont As LOGFONT
     15Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
    1616Dim _PromptSys_hFont As HFONT
    1717Dim _PromptSys_FontSize As SIZE
     
    2121Dim _PromptSys_CurPos As POINTAPI
    2222Dim _PromptSys_Buffer[100] As *Char
    23 Dim _PromptSys_TextColor[100] As DWordPtr
    24 Dim _PromptSys_BackColor[100] As DWordPtr
    25 Dim _PromptSys_NowTextColor As DWord
    26 Dim _PromptSys_NowBackColor As DWord
     23Dim _PromptSys_TextColor[100] As *COLORREF
     24Dim _PromptSys_BackColor[100] As *COLORREF
     25Dim _PromptSys_NowTextColor As COLORREF
     26Dim _PromptSys_NowBackColor As COLORREF
    2727Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION
    2828
     
    3838
    3939_PromptSys_bInitFinish=0
    40 CreateThread(
     40CreateThread( _
    4141    0,
    4242    0,
     
    5151Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
    5252    Dim i As Long, i2 As Long, i3 As Long
    53     Dim hOldFont As HFONT
    5453    Dim sz As SIZE
    5554    Dim temporary[2] As Char
    5655
    57     hOldFont=SelectObject(hDC,_PromptSys_hFont)
     56    Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
    5857
    5958    'Scroll
    6059    Dim rc As RECT
    61     GetClientRect(_PromptSys_hWnd,rc)
     60    GetClientRect(_PromptSys_hWnd, rc)
    6261    While (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy>rc.bottom and _PromptSys_CurPos.y>0
    63         HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[0])
    64         HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[0])
    65         HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[0])
     62        _System_free(_PromptSys_Buffer[0])
     63        _System_free(_PromptSys_TextColor[0])
     64        _System_free(_PromptSys_BackColor[0])
    6665        For i=0 To 100-1
    67             _PromptSys_Buffer[i]=_PromptSys_Buffer[i+1]
    68             _PromptSys_TextColor[i]=_PromptSys_TextColor[i+1]
    69             _PromptSys_BackColor[i]=_PromptSys_BackColor[i+1]
     66            _PromptSys_Buffer[i] = _PromptSys_Buffer[i+1]
     67            _PromptSys_TextColor[i] = _PromptSys_TextColor[i+1]
     68            _PromptSys_BackColor[i] = _PromptSys_BackColor[i+1]
    7069        Next
    71         _PromptSys_Buffer[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)
    72         _PromptSys_TextColor[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
    73         _PromptSys_BackColor[100]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
     70        _PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255)
     71        _PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
     72        _PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
    7473
    7574        _PromptSys_CurPos.y--
     
    8281    While i*_PromptSys_FontSize.cy<rc.bottom and i<=100
    8382        If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
    84             GetTextExtentPoint32(hDC,_PromptSys_Buffer[i],lstrlen(_PromptSys_Buffer[i]),sz)
     83            i3 = lstrlen(_PromptSys_Buffer[i])
     84            GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)
     85
    8586            BitBlt(hDC,_
    8687                sz.cx, i*_PromptSys_FontSize.cy, _
     
    8889                _PromptSys_hMemDC,sz.cx,i*_PromptSys_FontSize.cy,SRCCOPY)
    8990
    90             i3=lstrlen(_PromptSys_Buffer[i])
    91             For i2=0 To i3-1
    92                 SetTextColor(hDC,_PromptSys_TextColor[i][i2])
    93                 If _PromptSys_BackColor[i][i2]=-1 Then
    94                     SetBkMode(hDC,TRANSPARENT)
     91            For i2 = 0 To i3-1
     92                SetTextColor(hDC, _PromptSys_TextColor[i][i2])
     93                If _PromptSys_BackColor[i][i2] = -1 Then
     94                    SetBkMode(hDC, TRANSPARENT)
    9595                Else
    96                     SetBkMode(hDC,OPAQUE)
    97                     SetBkColor(hDC,_PromptSys_BackColor[i][i2])
     96                    SetBkMode(hDC, OPAQUE)
     97                    SetBkColor(hDC, _PromptSys_BackColor[i][i2])
    9898                End If
    9999
     100                Dim tempLen As Long
    100101                temporary[0]=_PromptSys_Buffer[i][i2]
    101102#ifdef UNICODE
     
    104105                If IsDBCSLeadByte(temporary[0]) Then
    105106#endif
    106                     temporary[1]=_PromptSys_Buffer[i][i2+1]
    107                     temporary[2]=0
     107                    temporary[1] = _PromptSys_Buffer[i][i2+1]
     108                    temporary[2] = 0
    108109                    i2++
     110                    tempLen = 2
    109111                Else
    110                     temporary[1]=0
     112                    temporary[1] = 0
     113                    tempLen = 1
    111114                End If
    112                 TextOut(hDC,i2*_PromptSys_FontSize.cx,i*_PromptSys_FontSize.cy,_
    113                     temporary,lstrlen(temporary))
     115                With _PromptSys_FontSize
     116                    TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen)
     117                End With
    114118            Next
    115119        End If
     
    118122    Wend
    119123
    120     SelectObject(hDC,hOldFont)
     124    SelectObject(hDC, hOldFont)
    121125End Sub
    122126
    123127Sub PRINT_ToPrompt(buf As String)
    124128    EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
    125 
    126         Dim hDC As HDC
     129    With _PromptSys_CurPos
    127130        Dim StartLine As Long
    128         Dim i2 As Long, i3 As Long
    129 
    130         StartLine=_PromptSys_CurPos.y
    131 
     131        StartLine = .y
    132132        'Addition
    133         i2=0
     133        Dim i2 = 0 As Long, i3 As Long
    134134        Do
    135             If buf[i2]=9 Then   'tab
    136                 i3=8-(_PromptSys_CurPos.x mod 8)
    137 
    138                 FillMemory(_PromptSys_Buffer[_PromptSys_CurPos.y]+_PromptSys_CurPos.x,i3,Asc(" "))
    139 
     135            If buf[i2] = 9 Then 'tab
     136                i3 = 8 - (.x And 7) '(.x mod 8)
     137                Dim j As Long
     138                Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char
     139                ' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" "))
     140                For j = 0 To ELM(i3)
     141                    p[j] = &h20 'Asc(" ")
     142                Next
    140143                i2++
    141                 _PromptSys_CurPos.x += i3
     144                .x += i3
    142145                Continue
    143146            End If
    144147
    145             If buf[i2]=13 and buf[i2+1]=10 Then '\r\n
     148            If buf[i2] = 13 and buf[i2+1] = 10 Then '\r\n
    146149                i2 += 2
    147                 _PromptSys_CurPos.y++
    148                 _PromptSys_CurPos.x=0
     150                .y++
     151                .x = 0
    149152                Continue
    150153            End If
    151154
    152             If buf[i2]=0 Then Exit Do
    153             _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=buf[i2]
    154             _PromptSys_TextColor[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowTextColor
    155             _PromptSys_BackColor[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=_PromptSys_NowBackColor
     155            If buf[i2] = 0 Then Exit Do
     156            _PromptSys_Buffer[.y][.x] = buf[i2]
     157            _PromptSys_TextColor[.y][.x] = _PromptSys_NowTextColor
     158            _PromptSys_BackColor[.y][.x] = _PromptSys_NowBackColor
    156159
    157160            i2++
    158             _PromptSys_CurPos.x++
     161            .x++
    159162        Loop
    160 
    161163        'Draw the text buffer added
    162         hDC=GetDC(_PromptSys_hWnd)
    163         DrawPromptBuffer(hDC,StartLine,_PromptSys_CurPos.y)
    164         ReleaseDC(_PromptSys_hWnd,hDC)
    165 
     164        Dim hDC = GetDC(_PromptSys_hWnd)
     165        DrawPromptBuffer(hDC, StartLine, .y)
     166        ReleaseDC(_PromptSys_hWnd, hDC)
     167    End With
    166168    LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
    167169End Sub
     
    172174    Dim ps As PAINTSTRUCT
    173175    Dim TempStr As String
    174     Dim temporary[255] As Byte
    175176    Dim CompForm As COMPOSITIONFORM
    176     Dim hGlobal As HGLOBAL
    177177
    178178    Select Case message
    179179        Case WM_CREATE
    180             hDC=GetDC(hWnd)
    181             _PromptSys_hBitmap=CreateCompatibleBitmap(hDC,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy)
    182             _PromptSys_hMemDC=CreateCompatibleDC(hDC)
    183             SelectObject(_PromptSys_hMemDC,_PromptSys_hBitmap)
     180            hDC = GetDC(hWnd)
     181            With _PromptSys_ScreenSize
     182                _PromptSys_hBitmap = CreateCompatibleBitmap(hDC, .cx, .cy)
     183            End With
     184            _PromptSys_hMemDC = CreateCompatibleDC(hDC)
     185            SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap)
    184186
    185187            'Initialize for Win9x
    186             Dim hOldBrush As HBRUSH
    187             hOldBrush=SelectObject(_PromptSys_hMemDC,GetStockObject(BLACK_BRUSH))
    188             PatBlt(_PromptSys_hMemDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,PATCOPY)
    189             SelectObject(_PromptSys_hMemDC,hOldBrush)
    190 
    191             Dim hOldFont As HFONT
     188            Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
     189            With _PromptSys_ScreenSize
     190                PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
     191            End With
     192            SelectObject(_PromptSys_hMemDC, hOldBrush)
     193
    192194            Dim tm As TEXTMETRIC
    193             hOldFont=SelectObject(_PromptSys_hMemDC,_PromptSys_hFont)
    194             GetTextExtentPoint32(_PromptSys_hMemDC," ",1,_PromptSys_FontSize)
    195             GetTextMetrics(_PromptSys_hMemDC,tm)
    196             SelectObject(_PromptSys_hMemDC,hOldFont)
    197             _PromptSys_FontSize.cy=tm.tmHeight
     195            Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
     196            GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize)
     197            GetTextMetrics(_PromptSys_hMemDC, tm)
     198            SelectObject(_PromptSys_hMemDC, hOldFont)
     199            _PromptSys_FontSize.cy = tm.tmHeight
    198200
    199201            ReleaseDC(hWnd,hDC)
    200202        Case WM_PAINT
    201             hDC=BeginPaint(hWnd,ps)
    202             BitBlt(hDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,_PromptSys_hMemDC,0,0,SRCCOPY)
    203             DrawPromptBuffer(hDC,-1,0)
    204             EndPaint(hWnd,ps)
    205 
    206             _PromptSys_bInitFinish=1
     203            hDC = BeginPaint(hWnd,ps)
     204            With _PromptSys_ScreenSize
     205                BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
     206            End With
     207            DrawPromptBuffer(hDC, -1, 0)
     208            EndPaint(hWnd, ps)
     209
     210            _PromptSys_bInitFinish = TRUE
    207211        Case WM_SETFOCUS
    208212            If _PromptSys_InputLen<>-1 Then
    209                 hIMC=ImmGetContext(hWnd)
     213                hIMC = ImmGetContext(hWnd)
    210214                If hIMC Then
    211                     CompForm.dwStyle=CFS_POINT
    212                     CompForm.ptCurrentPos.x=_PromptSys_CurPos.x*_PromptSys_FontSize.cx
    213                     CompForm.ptCurrentPos.y=_PromptSys_CurPos.y*_PromptSys_FontSize.cy
    214                     ImmSetCompositionWindow(hIMC,CompForm)
    215                     ImmSetCompositionFont(hIMC,_PromptSys_LogFont)
     215                    With CompForm
     216                        .dwStyle = CFS_POINT
     217                        .ptCurrentPos.x = _PromptSys_CurPos.x*_PromptSys_FontSize.cx
     218                        .ptCurrentPos.y = _PromptSys_CurPos.y*_PromptSys_FontSize.cy
     219                    End With
     220                    ImmSetCompositionWindow(hIMC, CompForm)
     221                    ImmSetCompositionFontA(hIMC, _PromptSys_LogFont)
    216222                End If
    217                 ImmReleaseContext(hWnd,hIMC)
     223                ImmReleaseContext(hWnd, hIMC)
    218224
    219225                CreateCaret(hWnd,NULL,9,6)
     
    230236            End If
    231237        Case WM_CHAR
    232             If _PromptSys_InputLen<>-1 Then
    233                 If wParam=VK_BACK Then
     238            If _PromptSys_InputLen <> -1 Then
     239                If wParam = VK_BACK Then
    234240                    If _PromptSys_InputLen Then
    235                         _PromptSys_InputLen=_PromptSys_InputLen-1
    236                         _PromptSys_InputStr[_PromptSys_InputLen]=0
    237 
    238                         _PromptSys_CurPos.x=_PromptSys_CurPos.x-1
    239                         _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x]=0
     241                        _PromptSys_InputLen--
     242                        _PromptSys_InputStr[_PromptSys_InputLen] = 0
     243
     244                        _PromptSys_CurPos.x--
     245                        _PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] = 0
    240246                    End If
    241                 ElseIf wParam=VK_RETURN Then
    242                     _PromptSys_InputStr[_PromptSys_InputLen]=0
    243                     _PromptSys_InputLen=-1
    244                     TempStr=Ex"\r\n"
    245                 ElseIf wParam=&H16 Then
     247                ElseIf wParam = VK_RETURN Then
     248                    _PromptSys_InputStr[_PromptSys_InputLen] = 0
     249                    _PromptSys_InputLen = -1
     250                    TempStr = Ex"\r\n"
     251                ElseIf wParam = &H16 Then
    246252                    'Paste Command(Use Clippboard)
    247253                    OpenClipboard(hWnd)
    248                     hGlobal=GetClipboardData(CF_TEXT)
    249                     If hGlobal=0 Then PromptProc=0:Exit Function
    250                     Dim pTemp=GlobalLock(hGlobal) As *Byte
    251 #ifdef UNICODE
     254                    Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
     255                    If hGlobal = 0 Then Return 0
     256                    Dim pTemp = GlobalLock(hGlobal) As PCSTR
     257#ifdef UNICODE 'A版ウィンドウプロシージャ用
    252258                    Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1
    253                     TempStr=ZeroString(tempSizeW)
     259                    TempStr = ZeroString(tempSizeW)
    254260                    MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW)
    255261#else
    256                     TempStr=ZeroString(lstrlen(pTemp)+1)
    257                     lstrcpy(StrPtr(TempStr),pTemp)
     262                    TempStr = ZeroString(lstrlen(pTemp) + 1)
     263                    lstrcpy(StrPtr(TempStr), pTemp)
    258264#endif
    259                     lstrcpy((VarPtr(_PromptSys_InputStr[0])+_PromptSys_InputLen) As *Byte,pTemp)
    260                     _PromptSys_InputLen=_PromptSys_InputLen+lstrlen(pTemp)
     265                    memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length)
     266                    _PromptSys_InputLen += TempStr.Length
    261267
    262268                    GlobalUnlock(hGlobal)
    263269                    CloseClipboard()
    264270                Else
    265                     _PromptSys_InputStr[_PromptSys_InputLen]=wParam As Byte
     271                    _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
    266272                    _PromptSys_InputLen++
    267273
    268                     temporary[0]=wParam As Byte
    269                     temporary[1]=0
    270                     TempStr=temporary
     274                    TempStr.ReSize(1)
     275                    TempStr[0] = wParam As Char
    271276                End If
    272277
    273                 SendMessage(hWnd,WM_KILLFOCUS,0,0)
     278                SendMessage(hWnd, WM_KILLFOCUS, 0, 0)
    274279                PRINT_ToPrompt(TempStr)
    275                 SendMessage(hWnd,WM_SETFOCUS,0,0)
     280                SendMessage(hWnd, WM_SETFOCUS, 0, 0)
    276281            End If
    277282        Case WM_DESTROY
     
    292297    'Allocate
    293298    For i=0 To 100
    294         _PromptSys_Buffer[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255)
    295         _PromptSys_TextColor[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
    296         _PromptSys_BackColor[i]=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,255*SizeOf(LONG_PTR))
     299        _PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255)
     300        _PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
     301        _PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
    297302    Next
    298303
     
    306311
    307312    'LogFont initialize
    308     _PromptSys_LogFont.lfHeight=-16
    309     _PromptSys_LogFont.lfWidth=0
    310     _PromptSys_LogFont.lfEscapement=0
    311     _PromptSys_LogFont.lfOrientation=0
    312     _PromptSys_LogFont.lfWeight=0
    313     _PromptSys_LogFont.lfItalic=0
    314     _PromptSys_LogFont.lfUnderline=0
    315     _PromptSys_LogFont.lfStrikeOut=0
    316     _PromptSys_LogFont.lfCharSet=SHIFTJIS_CHARSET
    317     _PromptSys_LogFont.lfOutPrecision=OUT_DEFAULT_PRECIS
    318     _PromptSys_LogFont.lfClipPrecision=CLIP_DEFAULT_PRECIS
    319     _PromptSys_LogFont.lfQuality=DEFAULT_QUALITY
    320     _PromptSys_LogFont.lfPitchAndFamily=FIXED_PITCH
    321     lstrcpy(_PromptSys_LogFont.lfFaceName,"MS 明朝")
    322 
    323     _PromptSys_hFont=CreateFontIndirect(_PromptSys_LogFont)
     313    With _PromptSys_LogFont
     314        .lfHeight = -16
     315        .lfWidth = 0
     316        .lfEscapement = 0
     317        .lfOrientation = 0
     318        .lfWeight = 0
     319        .lfItalic = 0
     320        .lfUnderline = 0
     321        .lfStrikeOut = 0
     322        .lfCharSet = SHIFTJIS_CHARSET
     323        .lfOutPrecision = OUT_DEFAULT_PRECIS
     324        .lfClipPrecision = CLIP_DEFAULT_PRECIS
     325        .lfQuality = DEFAULT_QUALITY
     326        .lfPitchAndFamily = FIXED_PITCH
     327        lstrcpy(.lfFaceName, "MS 明朝")
     328    End With
     329
     330    _PromptSys_hFont = CreateFontIndirect(ByVal VarPtr(_PromptSys_LogFont))
    324331
    325332    'Critical Section
     
    338345    wcl.lpfnWndProc=AddressOf(PromptProc)
    339346    wcl.hbrBackground=GetStockObject(BLACK_BRUSH)
    340     RegisterClassEx(wcl)
     347    Dim atom = RegisterClassEx(wcl)
    341348
    342349    'Create Prompt Window
    343     _PromptSys_hWnd=CreateWindowEx(WS_EX_CLIENTEDGE,"PROMPT","BASIC PROMPT",WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,GetModuleHandle(0),0)
     350    _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)
    344351    ShowWindow(_PromptSys_hWnd,SW_SHOW)
    345352    UpdateWindow(_PromptSys_hWnd)
     
    353360    Loop
    354361
     362    '強制的に終了する
     363    ExitProcess(0)
     364
    355365    EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
    356         For i=0 to 100
    357             HeapFree(_System_hProcessHeap,0,_PromptSys_Buffer[i])
    358             HeapFree(_System_hProcessHeap,0,_PromptSys_TextColor[i])
    359             HeapFree(_System_hProcessHeap,0,_PromptSys_BackColor[i])
    360         Next
    361 
    362         '強制的に終了する
    363         ExitProcess(0)
     366   
     367    For i=0 to 100
     368        _System_free(_PromptSys_Buffer[i])
     369        _System_free(_PromptSys_TextColor[i])
     370        _System_free(_PromptSys_BackColor[i])
     371    Next
    364372
    365373    LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
     
    432440
    433441    'Set value to variable
    434     i=0
    435     i2=0
    436     buf=ZeroString(lstrlen(_PromptSys_InputStr))
     442    i = 0
     443    i2 = 0
     444    buf = ZeroString(lstrlen(_PromptSys_InputStr))
    437445    While 1
    438         i3=0
     446        i3 = 0
    439447        While 1
    440             If _PromptSys_InputStr[i2]=Asc(",") Then
    441                 buf.Chars[i3]=0
     448            If _PromptSys_InputStr[i2] = &h2c Then
     449                buf.Chars[i3] = 0
    442450                Exit While
    443451            End If
    444452
    445             buf.Chars[i3]=_PromptSys_InputStr[i2]
    446 
    447             If _PromptSys_InputStr[i2]=0 Then Exit While
     453            buf.Chars[i3] = _PromptSys_InputStr[i2]
     454
     455            If _PromptSys_InputStr[i2] = 0 Then Exit While
    448456
    449457            i2++
     
    451459        Wend
    452460
    453         Select Case _System_InputDataType[i]
    454             Case _System_Type_Double
    455                 SetDouble(_System_InputDataPtr[i],Val(buf))
    456             Case _System_Type_Single
    457                 SetSingle(_System_InputDataPtr[i],Val(buf))
    458             Case _System_Type_Int64,_System_Type_QWord
    459                 SetQWord(_System_InputDataPtr[i],Val(buf))
    460             Case _System_Type_Long,_System_Type_DWord
    461                 SetDWord(_System_InputDataPtr[i],Val(buf))
    462             Case _System_Type_Integer,_System_Type_Word
    463                 SetWord(_System_InputDataPtr[i],Val(buf))
    464             Case _System_Type_SByte,_System_Type_Byte
    465                 SetByte(_System_InputDataPtr[i],Val(buf))
    466             Case _System_Type_Char
    467 #ifdef UNICODE
    468                 SetWord(_System_InputDataPtr[i], buf[0])
    469 #else
    470                 SetByte(_System_InputDataPtr[i], buf[0])
    471 #endif
    472             Case _System_Type_String
    473             *INPUT_FromPrompt_Type_String
    474                 Dim pTempStr As *String
    475                 pTempStr=_System_InputDataPtr[i] As *String
    476                 pTempStr->ReSize(i3)
    477                 memcpy(pTempStr->Chars, buf.Chars, pTempStr->Length)
    478                 pTempStr->Chars[pTempStr->Length] = 0
    479             Case 13
    480                 Goto *INPUT_FromPrompt_Type_String
    481         End Select
     461        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)
    482462
    483463        i++
    484         If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=Asc(",") Then
     464        If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=&h2c Then 'Asc(",")
    485465            PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
    486466            Goto *InputReStart
     
    494474        End If
    495475
    496         i2=i2+1
     476        i2++
    497477    Wend
    498478End Sub
     
    534514    'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
    535515
    536     Dim hDC As HDC
    537     Dim hPen As HPEN, hOldPen As VoidPtr
    538     Dim hBrush As HBRUSH, hOldBrush As VoidPtr
     516    Dim hBrush As HBRUSH
    539517    Dim radi2 As Long
    540518    Dim sw As Long
    541519    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
    542520
    543     hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
     521    Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
    544522    If bFill Then
    545523        hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
     
    548526    End If
    549527
    550     hDC=GetDC(_PromptSys_hWnd)
     528    Dim hDC=GetDC(_PromptSys_hWnd)
    551529    SelectObject(hDC,hPen)
    552530    SelectObject(hDC,hBrush)
    553     hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
    554     hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
     531    Dim hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
     532    Dim hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
    555533
    556534    If Aspect<1 Then
     
    664642    End If
    665643
    666     Dim hDC As HDC
    667     Dim hPen As HPEN, hOldPen As VoidPtr
    668     Dim hBrush As HBRUSH, hOldBrush As VoidPtr
    669 
    670     hDC=GetDC(_PromptSys_hWnd)
    671     hPen=CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
     644    Dim hDC = GetDC(_PromptSys_hWnd)
     645    Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
     646    Dim hBrush As HBRUSH
    672647    If fType=2 Then
    673648        hBrush=CreateSolidBrush(GetBasicColor(BrushColor))
     
    678653    SelectObject(hDC,hPen)
    679654    SelectObject(hDC,hBrush)
    680     hOldPen=SelectObject(_PromptSys_hMemDC,hPen)
    681     hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)
     655    Dim hOldPen = SelectObject(_PromptSys_hMemDC,hPen)
     656    Dim hOldBrush = SelectObject(_PromptSys_hMemDC,hBrush)
    682657
    683658    Select Case fType
     
    710685    'PSet (x,y),ColorCode
    711686
    712     Dim hDC As HDC
    713 
    714     hDC=GetDC(_PromptSys_hWnd)
     687    Dim hDC=GetDC(_PromptSys_hWnd)
    715688    SetPixel(hDC,x,y,GetBasicColor(ColorCode))
    716689    SetPixel(_PromptSys_hMemDC,x,y,GetBasicColor(ColorCode))
Note: See TracChangeset for help on using the changeset viewer.