Changeset 272 for Include/basic


Ignore:
Timestamp:
Jun 12, 2007, 7:24:38 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

StringBuilderを追加。String不変へ。共通の文字列操作関数をActiveBasic.Strings内に配置（設計に検討の余地あり）。

Location:
Include/basic
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Include/basic/command.sbp

    r269 r272  
    163163Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
    164164Sub INPUT_FromFile(FileNumber As Long)
    165     Dim i As Long ,i2 As Long, i3 As Long
    166     Dim buffer As String
     165    FileNumber--
     166   
     167    Dim i = 0 As Long
     168    Dim i2 As Long, i3 As Long
     169    Dim buffer = New System.Text.StringBuilder(GetFileSize(_System_hFile[FileNumber], 0) + 1)
    167170    Dim temp[1] As StrChar
    168171    Dim dwAccessBytes As DWord
    169172    Dim IsStr As Long
    170173
    171     FileNumber--
    172 
    173     buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0) + 1)
    174 
    175     i=0
    176174    While 1
    177175        '次のデータをサーチ
    … …  
    226224
    227225        'データを変数に格納
    228         _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
     226        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
    229227
    230228
    … …  
    234232End Sub
    235233
    236 Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
     234Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
    237235    Select Case dataType
    238236        Case _System_Type_Double
    … …  
    253251            Dim pTempStr As *String
    254252            pTempStr = arg As *String
    255             pTempStr->ReSize(bufLen)
    256             memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length)
    257             pTempStr->Chars[pTempStr->Length] = 0
     253            pTempStr[0] = buf
    258254    End Select
    259255End Sub
    … …  
    269265Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char     'TODO: 暫定対応（動作未確認）
    270266Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
     267/*
    271268Function _System_GetUsingFormat(UsingStr As String) As String
    272269    Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
    273270    Dim temporary[255] As StrChar
    274     Dim buffer As String
    275 
    276     buffer = ZeroString(1024)
     271    Dim buffer = New System.Text.StringBuilder(1024)
    277272
    278273    ParmNum = 0
    … …  
    334329            If length_buf>=length_num Then
    335330                '通常時
    336                 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
     331                ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
    337332
    338333                i3 += length_buf - length_num
    … …  
    354349            Else
    355350                '表示桁が足りないとき
    356                 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
     351                ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
    357352                i3 += length_buf
    358353            End If
    … …  
    395390                    i5=i4
    396391                Else
    397                     _System_FillChar(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
     392                    ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
    398393                End If
    399394                memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
    … …  
    411406    Wend
    412407
    413     _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
     408    _System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
    414409End Function
     410*/
    415411Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
    416412    Dim dwAccessByte As DWord

  • Include/basic/dos_console.sbp

    r268 r272  
    88
    99#include <api_console.sbp>
     10#include <Classes/ActiveBasic/Strings/Strings.ab>
    1011
    1112Dim _System_hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
    … …  
    1718'---------------------------------------------
    1819Sub INPUT_FromPrompt(ShowStr As String)
    19     Dim i As Long, i2 As Long, i3 As Long
    20     Dim buf As String
    2120    Dim InputBuf[1023] As TCHAR
    2221    Dim dwAccessBytes As DWord
    … …  
    3029    If InputBuf[dwAccessBytes-2] = &h0d And InputBuf[dwAccessBytes-1] = &h0a Then
    3130        InputBuf[dwAccessBytes-2] = 0
     31        dwAccessBytes -= 2
    3232    End If
    33     Dim InputStr As String(InputBuf)
     33
     34    If dwAccessBytes = 0 Then Goto *InputReStart
    3435
    3536    'データを変数に格納
    36     i=0
    37     i2=0
    38     buf.ReSize(lstrlen(InputStr) + 1, 0)
    39     Dim comma As Char
    40     comma = &h2c 'Asc(",")
    41     While 1
    42         i3=0
    43         While 1
    44             If InputStr[i2]=comma Then
    45                 buf[i3]=0
    46                 Exit While
    47             End If
    48 
    49             buf[i3]=InputStr[i2]
    50 
    51             If InputStr[i2]=0 Then Exit While
    52 
    53             i2++
    54             i3++
    55         Wend
    56 
    57         _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)
    58 
    59         i++
    60         If _System_InputDataPtr[i]=0 And InputStr[i2]=comma Then
     37    Const comma = &h2c As StrChar 'Asc(",")
     38    Dim broken = ActiveBasic.Strings.Detail.Split(New String(InputBuf, dwAccessBytes As Long), comma)
     39    Dim i As Long
     40    For i = 0 To ELM(broken.Count)
     41        If _System_InputDataPtr[i] = 0 Then
    6142            PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
    6243            Goto *InputReStart
    63         ElseIf InputStr[i2]=0 Then
    64             If _System_InputDataPtr[i]<>0 Then
    65                 PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
    66                 Goto *InputReStart
    67             Else
    68                 Exit While
    69             End If
    7044        End If
     45        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i].ToString)
     46    Next
    7147
    72         i2++
    73     Wend
     48    If _System_InputDataPtr[i]<>0 Then
     49        PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
     50        Goto *InputReStart
     51    End If
    7452End Sub
    7553
    … …  
    9068    _System_free(pszOut)
    9169#else
    92     WriteConsole(_System_hConsoleOut, buf.Chars, buf.Length, dwAccessBytes, 0)
     70    WriteConsole(_System_hConsoleOut, buf.StrPtr, buf.Length, dwAccessBytes, 0)
    9371#endif
    9472End Sub

  • Include/basic/function.sbp

    r269 r272  
    1313
    1414#require <Classes/System/Math.ab>
     15#require <Classes/System/DateTime.ab>
     16#require <Classes/System/Text/StringBuilder.ab>
    1517#require <Classes/ActiveBasic/Math/Math.ab>
     18#require <Classes/ActiveBasic/Strings/Strings.ab>
    1619
    1720
    … …  
    9295End Function
    9396
    94 Const RAND_MAX=&H7FFFFFFF
    95 Dim _System_RndNext=1 As DWord
     97Const RAND_MAX = &H7FFFFFFF
     98Dim _System_RndNext = 1 As DWord
    9699
    97100Function rand() As Long
    98101    _System_RndNext = _System_RndNext * 1103515245 + 12345
    99     rand = _System_RndNext >> 1
     102    rand = (_System_RndNext >> 1) As Long
    100103End Function
    101104
    … …  
    233236
    234237Function Chr$(code As StrChar) As String
    235     Chr$ = ZeroString(1)
    236     Chr$[0] = code
     238    Chr$ = New String(code, 1)
    237239End Function
    238240
    … …  
    252254Function ChrW(c As UCSCHAR) As String
    253255    If c <= &hFFFF Then
    254         ChrW.ReSize(1)
    255         ChrW[0] = c As WCHAR
     256        Return New String(c As StrChar, 1)
    256257    ElseIf c < &h10FFFF Then
    257         ChrW.ReSize(2)
    258         ChrW[0] = &hD800 Or (c >> 10)
    259         ChrW[1] = &hDC00 Or (c And &h3FF)
    260     Else
    261         ' OutOfRangeException
     258        Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As StrChar
     259        Return New String(t, 2)
     260    Else
     261        'ArgumentOutOfRangeException
    262262    End If
    263263End Function
    … …  
    265265
    266266Function Date$() As String
    267     Dim st As SYSTEMTIME
    268     GetLocalTime(st)
     267    Dim date = DateTime.Now
     268    Dim buf = New System.Text.StringBuilder(10)
    269269
    270270    'year
    271     Date$=Str$(st.wYear)
     271    buf.Append(date.Year)
    272272
    273273    'month
    274     If st.wMonth<10 Then
    275         Date$=Date$+"/0"
    276     Else
    277         Date$=Date$+"/"
    278     End If
    279     Date$=Date$+Str$(st.wMonth)
     274    If date.Month < 10 Then
     275        buf.Append("/0")
     276    Else
     277        buf.Append("/")
     278    End If
     279    buf.Append(date.Month)
    280280
    281281    'day
    282     If st.wDay<10 Then
    283         Date$=Date$+"/0"
    284     Else
    285         Date$=Date$+"/"
    286     End If
    287     Date$=Date$+Str$(st.wDay)
     282    If date.Day < 10 Then
     283        buf.Append("/0")
     284    Else
     285        buf.Append("/")
     286    End If
     287    buf.Append(date.Day)
     288
     289    Date$ = buf.ToString
    288290End Function
    289291
    … …  
    358360End Function
    359361
    360 Function Left$(buf As String, length As Long) As String
    361     Left$ = ZeroString(length)
    362     memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (StrChar) * length)
    363 End Function
    364 
    365 Function Mid$(buf As String, StartPos As Long)(ReadLength As Long) As String
    366     Dim length As Long
    367 
    368     StartPos--
    369     If StartPos<0 Then
    370         'error
    371         'Debug
    372         Exit Function
    373     End If
    374 
    375     length=Len(buf)
    376     If length<=StartPos Then Exit Function
    377 
    378     If ReadLength=0 Then
    379         ReadLength=length-StartPos
    380     End If
    381 
    382     If ReadLength>length-StartPos Then
    383         ReadLength=length-StartPos
    384     End If
    385 
    386     Mid$=ZeroString(ReadLength)
    387     memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (StrChar) * ReadLength)
    388 End Function
    389 
    390 Function Oct$(num As DWord) As String
    391     Dim i As DWord, i2 As DWord
    392 
    393     For i=10 To 1 Step -1
    394         If (num \ CDWord(8^i)) And &H07 Then
    395             Exit For
    396         End If
    397     Next
    398 
    399     Oct$=ZeroString(i+1)
    400     i2=0
     362Function Left$(s As String, length As Long) As String
     363    Left$ = s.Substring(0, System.Math.Min(s.Length, length))
     364End Function
     365
     366Function Mid$(s As String, startPos As Long) As String
     367    startPos--
     368    Mid$ = s.Substring(startPos)
     369End Function
     370
     371Function Mid$(s As String, startPos As Long, readLength = 0 As Long) As String
     372    startPos--
     373    Dim length = s.Length
     374    Mid$ = s.Substring(System.Math.Min(startPos, length), System.Math.Min(readLength, length - startPos))
     375End Function
     376
     377Const _System_MaxFigure_Oct_QW = 22 As DWord 'QWORD_MAX = &o1,777,777,777,777,777,777,777
     378Function Oct$(n As QWord) As String
     379    Dim s[ELM(_System_MaxFigure_Oct_QW)] As StrChar
     380    Dim i = ELM(_System_MaxFigure_Oct_QW) As Long
    401381    Do
    402         Oct$[i2] = &h30 + ((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
    403         If i=0 Then Exit Do
     382        s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
     383        n >>= 3
     384        If n = 0 Then
     385            Return New String(s + i, _System_MaxFigure_Oct_QW - i)
     386        End If
    404387        i--
    405         i2++
    406388    Loop
    407389End Function
    408390
    409 Function Right$(buf As String, length As Long) As String
    410     Dim i As Long
    411 
    412     i=Len(buf)
    413     If i>length Then
    414         Right$=ZeroString(length)
    415         memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (StrChar) * length)
    416     Else
    417         Right$=buf
    418     End If
     391Const _System_MaxFigure_Oct_DW = 11 As DWord 'DWORD_MAX = &o37,777,777,777
     392Function Oct$(n As DWord) As String
     393    Dim s[ELM(_System_MaxFigure_Oct_DW)] As StrChar
     394    Dim i = ELM(_System_MaxFigure_Oct_DW) As Long
     395    Do
     396        s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
     397        n >>= 3
     398        If n = 0 Then
     399            Return New String(s + i, _System_MaxFigure_Oct_DW - i)
     400        End If
     401        i--
     402    Loop
     403End Function
     404
     405Function Right$(s As String, length As Long) As String
     406    Right$ = s.Substring(System.Math.Max(0, s.Length - length), s.Length)
    419407End Function
    420408
    … …  
    447435    '値が0の場合
    448436    If value = 0 Then
    449         _System_FillChar(_System_ecvt_buffer, count As SIZE_T, &H30 As StrChar)
     437        ActiveBasic.Strings.ChrFill(_System_ecvt_buffer, count As SIZE_T, &H30 As StrChar)
    450438        _System_ecvt_buffer[count] = 0
    451439        dec = 0
    … …  
    523511        buffer[i] = Asc(".")
    524512        i++
    525         memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
     513        ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14)
    526514        i += 14
    527515        buffer[i] = Asc("e")
    528516        i++
    529         _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
     517        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応
    530518
    531519        Return MakeStr(buffer)
    … …  
    538526        buffer[i] = Asc(".")
    539527        i++
    540         memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
     528        ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14)
    541529        i+=14
    542530        buffer[i] = Asc("e")
    543531        i++
    544         _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
     532        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応
    545533
    546534        Return MakeStr(buffer)
    … …  
    603591
    604592    Dim buf[20] As StrChar
    605     buf[20] = 0
     593    'buf[20] = 0
    606594    Dim i = 19 As Long
    607595    Do
    … …  
    640628    Dim i = 9 As Long
    641629    Do
    642         buf[i] = (x Mod 10 + &h30) As StrChar
     630        buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策
    643631        x \= 10
    644632        If x = 0 Then
    645             Exit Do
     633            Return New String(VarPtr(buf[i]), 10 - i)
    646634        End If
    647635        i--
    648     Loop
    649     Return New String(VarPtr(buf[i]), 10 - i)
     636    Loop   
    650637#endif
    651638End Function
    … …  
    679666End Function
    680667
    681 Function String$(num As Long, buf As String) As String
    682     Dim dwStrPtr As DWord
    683     Dim length As Long
    684 
    685     length=Len(buf)
    686 
    687     'バッファ領域を確保
    688     String$=ZeroString(length*num)
    689 
    690     '文字列をコピー
     668Function String$(n As Long, s As StrChar) As String
     669    Return New String(s, n)
     670End Function
     671       
     672#ifdef _AB4_COMPATIBILITY_STRING$_
     673Function String$(n As Long, s As String) As String
     674    If n < 0 Then
     675        'Throw ArgumentOutOfRangeException
     676    End If
     677
     678    Dim buf = New System.Text.StringBuilder(s.Length * n)
    691679    Dim i As Long
    692     For i=0 To num-1
    693         memcpy(VarPtr(String$.Chars[i*length]), StrPtr(buf), SizeOf (StrChar) * length)
     680    For i = 0 To n
     681        buf.Append(s)
    694682    Next
    695683End Function
     684#else
     685Function String$(n As Long, s As String) As String
     686    If String.IsNullOrEmpty(s) Then
     687        Return New String(0 As StrChar, n)
     688            Else
     689        Return New String(s[0], n)
     690    End If
     691End Function
     692#endif
    696693
    697694Function Time$() As String
    698     Dim st As SYSTEMTIME
    699 
    700     GetLocalTime(st)
     695    Dim time = DateTime.Now
     696
     697    Dim buf = New System.Text.StringBuilder(8)
    701698
    702699    'hour
    703     If st.wHour<10 Then
    704         Time$="0"
    705     End If
    706     Time$=Time$+Str$(st.wHour)
     700    If time.Hour < 10 Then
     701        buf.Append("0")
     702    End If
     703    buf.Append(time.Hour)
    707704
    708705    'minute
    709     If st.wMinute<10 Then
    710         Time$=Time$+":0"
    711     Else
    712         Time$=Time$+":"
    713     End If
    714     Time$=Time$+Str$(st.wMinute)
     706    If time.Minute < 10 Then
     707        buf.Append(":0")
     708    Else
     709        buf.Append(":")
     710    End If
     711    buf.Append(time.Minute)
    715712
    716713    'second
    717     If st.wSecond<10 Then
    718         Time$=Time$+":0"
    719     Else
    720         Time$=Time$+":"
    721     End If
    722     Time$=Time$+Str$(st.wSecond)
     714    If time.Second < 10 Then
     715        buf.Append(":0")
     716    Else
     717        buf.Append(":")
     718    End If
     719    buf.Append(time.Second)
     720    Time$ = buf.ToString
    723721End Function
    724722
    … …  
    738736    If buf[0]=Asc("&") Then
    739737        temporary = New String( buf )
    740         temporary.ToUpper()
     738        temporary = temporary.ToUpper()
    741739        TempPtr = StrPtr(temporary)
    742740        If TempPtr(1)=Asc("O") Then
    … …  
    816814
    817815Function Loc(FileNum As Long) As Long
    818     Dim NowPos As Long, BeginPos As Long
    819 
    820816    FileNum--
    821817
    822     NowPos=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_CURRENT)
    823     BeginPos=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_BEGIN)
    824     SetFilePointer(_System_hFile(FileNum),NowPos-BeginPos,NULL,FILE_BEGIN)
    825 
    826     Loc=NowPos-BeginPos
     818    Dim NowPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_CURRENT)
     819    Dim BeginPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_BEGIN)
     820    SetFilePointer(_System_hFile(FileNum), NowPos - BeginPos, 0, FILE_BEGIN)
     821
     822    Loc = NowPos - BeginPos
    827823End Function
    828824
    … …  
    851847    _System_pGC->__free(lpMem)
    852848End Sub
    853 
    854849
    855850Function _System_malloc(stSize As SIZE_T) As VoidPtr
    … …  
    10441039End Function
    10451040
    1046 Sub _System_FillChar(p As PWSTR, n As SIZE_T, c As WCHAR)
    1047     Dim i As SIZE_T
    1048     For i = 0 To ELM(n)
    1049         p[i] = c
    1050     Next
    1051 End Sub
    1052 
    1053 Sub _System_FillChar(p As PSTR, n As SIZE_T, c As SByte)
    1054     Dim i As SIZE_T
    1055     For i = 0 To ELM(n)
    1056         p[i] = c
    1057     Next
    1058 End Sub
    1059 
    10601041Function _System_ASCII_IsUpper(c As WCHAR) As Boolean
    10611042    Return c As DWord - &h41 < 26 ' &h41 = Asc("A")
    … …  
    10961077Function _System_ASCII_ToUpper(c As SByte) As SByte
    10971078    Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte
    1098 End Function
    1099 
    1100 Function _System_ChrCpy(dst As PCWSTR, src As PCWSTR, size As SIZE_T) As PCWSTR
    1101     memcpy(dst, src, size * SizeOf (WCHAR))
    1102     Return dst
    1103 End Function
    1104 
    1105 Function _System_ChrCpy(dst As PCSTR, src As PCSTR, size As SIZE_T) As PCSTR
    1106     memcpy(dst, src, size)
    1107     Return dst
    1108 End Function
    1109 
    1110 Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long
    1111     Dim i = 0 As SIZE_T
    1112     While s1[i] = s2[i]
    1113         If s1[i] = 0 Then
    1114             Exit While
    1115         End If
    1116         i++
    1117     Wend
    1118     _System_StrCmp = s1[i] - s2[i]
    1119 End Function
    1120 
    1121 Function _System_StrCmp(s1 As PCWSTR, s2 As PCWSTR) As Long
    1122     Dim i = 0 As SIZE_T
    1123     While s1[i] = s2[i]
    1124         If s1[i] = 0 Then
    1125             Exit While
    1126         End If
    1127         i++
    1128     Wend
    1129     _System_StrCmp = s1[i] - s2[i]
    1130 End Function
    1131 
    1132 Function _System_StrCmpN(s1 As PCSTR, s2 As PCSTR, size As SIZE_T) As Long
    1133     Dim i = 0 As SIZE_T
    1134     For i = 0 To ELM(size)
    1135         _System_StrCmpN = s1[i] - s2[i]
    1136         If _System_StrCmpN <> 0 Then
    1137             Exit Function
    1138         End If
    1139     Next
    1140 End Function
    1141 
    1142 Function _System_StrCmpN(s1 As PCWSTR, s2 As PCWSTR, size As SIZE_T) As Long
    1143     Dim i = 0 As SIZE_T
    1144     For i = 0 To ELM(size)
    1145         _System_StrCmpN = s1[i] - s2[i]
    1146         If _System_StrCmpN <> 0 Then
    1147             Exit Function
    1148         End If
    1149     Next
    1150 End Function
    1151 
    1152 Function _System_MemChr(s As PCSTR, c As CHAR, size As SIZE_T) As PCSTR
    1153     Dim i As SIZE_T
    1154     For i = 0 To ELM(size)
    1155         If s[i] = c Then
    1156             Return VarPtr(s[i])
    1157         End If
    1158     Next
    1159     Return 0
    1160 End Function
    1161 
    1162 Function _System_MemChr(s As PCWSTR, c As WCHAR, size As SIZE_T) As PCWSTR
    1163     Dim i As SIZE_T
    1164     For i = 0 To ELM(size)
    1165         If s[i] = c Then
    1166             Return VarPtr(s[i])
    1167         End If
    1168     Next
    1169     Return 0
    1170 End Function
    1171 
    1172 Function _System_MemPBrk(str As PCSTR, cStr As SIZE_T, Chars As PCSTR, cChars As SIZE_T) As PCSTR
    1173     Dim i As SIZE_T
    1174     For i = 0 To ELM(cStr)
    1175         If _System_MemChr(Chars, str[i], cChars) Then
    1176             Return VarPtr(str[i])
    1177         End If
    1178     Next
    1179     Return 0
    1180 End Function
    1181 
    1182 Function _System_MemPBrk(str As PCWSTR, cStr As SIZE_T, Chars As PCWSTR, cChars As SIZE_T) As PCWSTR
    1183     Dim i As SIZE_T
    1184     For i = 0 To ELM(cStr)
    1185         If _System_MemChr(Chars, str[i], cChars) Then
    1186             Return VarPtr(str[i])
    1187         End If
    1188     Next
    1189     Return 0
    11901079End Function
    11911080

  • Include/basic/prompt.sbp

    r269 r272  
    7575
    7676Sub _PromptSys_Initialize()
    77 _PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0)
    78 Dim _PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain), 0, 0, _PromptSys_dwThreadID)
    79 If _PromptSys_hThread = 0 Then
    80     Debug
    81     ExitProcess(1)
    82 End If
    83 WaitForSingleObject(_PromptSys_hInitFinish, INFINITE)
     77    _PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0)
     78    Dim _PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain), 0, 0, _PromptSys_dwThreadID)
     79    If _PromptSys_hThread = 0 Then
     80        Debug
     81        ExitProcess(1)
     82    End If
     83    WaitForSingleObject(_PromptSys_hInitFinish, INFINITE)
    8484End Sub
    8585
    … …  
    191191                            charLen = 1
    192192                        EndIf
    193                         _PromptSys_GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]) As *StrChar, charLen, sz)
     193                        Dim p = buf.StrPtr
     194                        _PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *StrChar, charLen, sz)
    194195                        currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
    195196/*
    … …  
    363364*/
    364365        Else
    365             _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
     366            Dim t = wParam As TCHAR
     367            TempStr = New String(VarPtr(t), 1)
     368            _PromptSys_InputStr[_PromptSys_InputLen] = TempStr[0]
    366369            _PromptSys_InputLen++
    367 
    368             TempStr.ReSize(1)
    369             TempStr[0] = wParam As Char
    370370        End If
    371371
    … …  
    403403            Return 0
    404404        End If
    405         Dim tempStr As String
     405        Dim tempStr = Nothing As String
    406406        Dim str As *StrChar
    407407#ifdef __STRING_IS_NOT_UNICODE
    408408        Dim size = _PromptWnd_GetCompositionStringA(himc, str)
    409         tempStr.Assign(str, size)
     409        tempStr = New String(str, size As Long)
    410410#else
    411411        Dim osver = System.Environment.OSVersion
    … …  
    415415                Dim strA As PCSTR
    416416                Dim sizeA = _PromptWnd_GetCompositionStringA(himc, strA)
    417                 tempStr.AssignFromMultiByte(strA, sizeA)
     417                tempStr = New String(strA, sizeA As Long)
    418418            Else
    419419                Dim size = _PromptWnd_GetCompositionStringW(himc, str)
    420                 tempStr.Assign(str, size \ SizeOf (WCHAR))
     420                tempStr = New String(str, (size \ SizeOf (WCHAR)) As Long)
    421421            End If
    422422        End With
    … …  
    425425        _System_free(str)
    426426
    427         memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.Chars, SizeOf (StrChar) * tempStr.Length)
     427        ActiveBasic.Strings.ChrCopy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.StrPtr, tempStr.Length As SIZE_T)
    428428        _PromptSys_InputLen += tempStr.Length
    429429
    … …  
    583583
    584584Sub INPUT_FromPrompt(showStr As String)
    585     Dim i As Long, i2 As Long, i3 As Long
    586     Dim buf As String
    587 
    588585*InputReStart
    589586
    … …  
    599596
    600597    'Set value to variable
    601     i = 0
    602     i2 = 0
    603     buf = ZeroString(lstrlen(_PromptSys_InputStr))
    604     While 1
    605         i3 = 0
    606         While 1
    607             If _PromptSys_InputStr[i2] = &h2c Then
    608                 buf.Chars[i3] = 0
    609                 Exit While
    610             End If
    611 
    612             buf.Chars[i3] = _PromptSys_InputStr[i2]
    613 
    614             If _PromptSys_InputStr[i2] = 0 Then Exit While
    615 
    616             i2++
    617             i3++
    618         Wend
    619 
    620         _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)
    621 
    622         i++
    623         If _System_InputDataPtr[i] = 0 and _PromptSys_InputStr[i2] = &h2c Then 'Asc(",")
     598    Const comma = &h2c As StrChar 'Asc(",")
     599    Dim broken = ActiveBasic.Strings.Detail.Split(New String(_PromptSys_InputStr), comma)
     600    Dim i As Long
     601    For i = 0 To ELM(broken.Count)
     602        If _System_InputDataPtr[i] = 0 Then
    624603            ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
    625604            Goto *InputReStart
    626         ElseIf _PromptSys_InputStr[i2] = 0 Then
    627             If _System_InputDataPtr[i]<>0 Then
    628                 ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
    629                 Goto *InputReStart
    630             Else
    631                 Exit While
    632             End If
    633         End If
    634 
    635         i2++
    636     Wend
     605        End If
     606        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i].ToString)
     607    Next
     608
     609    If _System_InputDataPtr[i]<>0 Then
     610        ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
     611        Goto *InputReStart
     612    End If
    637613End Sub
    638614
Note: See TracChangeset for help on using the changeset viewer.