Changeset 388 for trunk/Include


Ignore:
Timestamp:
Nov 25, 2007, 4:31:35 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

Stringなどで例外を投げるようにした。
#147の解決。
CType ASCII文字判定関数群の追加。

Location:
trunk/Include
Files:
2 added
20 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab

    r386 r388  
    731731End Function
    732732
     733/*
     734@brief  0からFまでの文字を収めた表
     735@author egtra
     736*/
     737Dim HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte
     738
    733739/*!
    734740@author Egtra
    … …  
    739745    Dim x = xq As DWord
    740746    While x <> 0
    741         buf[i] = _System_HexadecimalTable[x And &h0f]
     747        buf[i] = HexadecimalTable[x And &h0f]
    742748        x >>= 4
    743749        i--
    … …  
    754760    Dim i = MaxSizeLX
    755761    While x <> 0
    756         buf[i] = _System_HexadecimalTable[x And &h0f]
     762        buf[i] = HexadecimalTable[x And &h0f]
    757763        x >>= 4
    758764        i--
    … …  
    12701276                s.Append(FormatString(params[i] As String, precision, fieldWidth, flags))
    12711277            Case &h63 'c
    1272                 s.Append(FormatCharacter(params[i] As BoxedStrChar, precision, fieldWidth, flags) As Char)
     1278                s.Append(FormatCharacter(params[i] As BoxedStrChar, precision, fieldWidth, flags))
    12731279'           Case &h6e 'n
    12741280            Case &h25 '%

  • trunk/Include/Classes/System/Environment.ab

    r337 r388  
    3131    Static Function CurrentDirectory() As String
    3232        Dim size = GetCurrentDirectory(0, 0)
    33         Dim p = _System_malloc(SizeOf (TCHAR) * size) As PCTSTR
     33        Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PCTSTR
    3434        Dim len = GetCurrentDirectory(size, p)
    3535        If len < size Then
    3636            CurrentDirectory = New String(p, size As Long)
    37             _System_free(p)
    3837        End If
    3938    End Function
    … …  
    9291        If Object.ReferenceEquals(sysDir, Nothing) Then
    9392            Dim size = GetSystemDirectory(0, 0)
    94             Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
     93            Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
    9594            Dim len = GetSystemDirectory(p, size)
    9695            sysDir = New String(p, len As Long)
    97             _System_free(p)
    9896        End If
    9997        Return sysDir
    … …  
    145143        Dim src = ToTCStr(s)
    146144        Dim size = ExpandEnvironmentStrings(src, 0, 0)
    147         Dim dst = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
     145        Dim dst = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
    148146        ExpandEnvironmentStrings(src, dst, size)
    149147        ExpandEnvironmentVariables = New String(dst, size - 1)
    150         _System_free(dst)
    151148    End Function
    152149
    … …  
    160157        Dim tcsVariable = ToTCStr(variable)
    161158        Dim size = _System_GetEnvironmentVariable(tcsVariable, 0, 0)
    162         Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
     159        Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
    163160        Dim len = _System_GetEnvironmentVariable(tcsVariable, p, size)
    164161        GetEnvironmentVariable = New String(p, len As Long)
    165         _System_free(p)
    166162    End Function
    167163

  • trunk/Include/Classes/System/IO/FileStream.ab

    r349 r388  
    11Namespace System
    22Namespace IO
    3 
    43
    54/* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */
    … …  
    2827    fileShare As DWord
    2928    fileOptions As DWord
    30     fileReadOverlapped As OVERLAPPED
    31     fileWriteOverlapped As OVERLAPPED
     29   
     30    offset As QWord 'オーバーラップドIO用
    3231
    3332Public
    … …  
    108107        This.fileShare = sh
    109108        This.fileOptions = op
     109        This.offset = 0
    110110    End Sub
    111111    Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare)
    … …  
    133133        This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
    134134    End Sub
    135 
    136     Sub ~FileStream()
    137         This.Flush()
    138         This.Close()
    139     End Sub
    140 
    141135Public
    142136    Override Function CanRead() As Boolean
    … …  
    176170    Function IsAsync() As Boolean
    177171        /* ファイルが非同期操作に対応しているかを返す */
    178         If This.fileOptions=FILE_FLAG_OVERLAPPED/*FileOptions.Asynchronous*/ Then
     172        If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
    179173            Return True
    180174        Else
    … …  
    187181            Dim length As LARGE_INTEGER
    188182            length.LowPart=GetFileSize(This.handle,VarPtr(length.HighPart) As *DWord)
    189             Return MAKEQWORD(length.LowPart,length.HighPart)
     183            Return MAKEQWORD(length.LowPart,length.HighPart) As Int64
    190184        End If
    191185    End Function
    192186
    193187    Function Name() As String
    194         Return New String(This.filePath)
     188        Return This.filePath
    195189    End Function
    196190   
    … …  
    198192        If This.CanSeek() Then
    199193            If This.IsAsync() Then
    200                 fileReadOverlapped.Offset=LODWORD(value)
    201                 fileReadOverlapped.OffsetHigh=HIDWORD(value)
    202                 fileWriteOverlapped.OffsetHigh=LODWORD(value)
    203                 fileWriteOverlapped.OffsetHigh=HIDWORD(value)
     194                offset = value As QWord
    204195            Else
    205196                Dim position As LARGE_INTEGER
    … …  
    213204        If This.CanSeek() Then
    214205            If This.IsAsync() Then
    215                 Return MAKEQWORD(fileReadOverlapped.Offset,fileReadOverlapped.OffsetHigh)
     206                Return offset As Int64
    216207            Else
    217208                Dim position As LARGE_INTEGER
    218209                ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER))
    219210                position.LowPart=SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_CURRENT)
    220                 Return MAKEQWORD(position.LowPart,position.HighPart)
     211                Return MAKEQWORD(position.LowPart,position.HighPart) As Int64
    221212            End If
    222213        End If
    … …  
    257248    End Function
    258249
    259     Override Sub Close()
    260         This.Dispose()
    261     End Sub
    262 
    263250/*  CreateObjRef*/
    264251   
    265     Override Sub Dispose()
     252    Override Sub Dispose(disposing As Boolean)
     253        Flush()
    266254        CloseHandle(InterlockedExchangePointer(VarPtr(This.handle),NULL))
    267255    End Sub
    268256
    269     Override Function EndRead(ByRef asyncResult As System.IAsyncResult) As Long
    270         'TODO
    271     End Function
    272 
    273     Override Sub EndWrite(ByRef asyncResult As System.IAsyncResult)
     257    Override Function EndRead(asyncResult As System.IAsyncResult) As Long
     258        'TODO
     259    End Function
     260
     261    Override Sub EndWrite(asyncResult As System.IAsyncResult)
    274262        'TODO
    275263    End Sub
    … …  
    298286
    299287    Sub Lock(position As Int64, length As Int64)
     288        If position < 0 Then
     289            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
     290        ElseIf length < 0 Then
     291            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
     292        End If
     293        LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
     294            LODWORD(length As QWord), HIDWORD(length As QWord))
    300295    End Sub
    301296
    302297    Override Function Read( buffer As *Byte, offset As Long, count As Long) As Long
    303298        If This.CanRead() Then
    304             Dim ret As DWord
    305             If This.IsAsync() Then
    306                 ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(ret),This.fileReadOverlapped)
    307                 While This.fileReadOverlapped.Internal=STATUS_PENDING
    308                 Wend
    309                 fileReadOverlapped.Offset+=LODWORD(ret)
    310                 fileReadOverlapped.OffsetHigh+=HIDWORD(ret)
    311                 fileWriteOverlapped.Offset+=LODWORD(ret)
    312                 fileWriteOverlapped.OffsetHigh+=HIDWORD(ret)
    313                 Return ret
    314             Else
    315                 ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(ret),ByVal NULL)
    316                 Return ret
    317             End If
     299            Dim readBytes As DWord
     300            If This.IsAsync() Then
     301                Dim overlapped As OVERLAPPED
     302                SetQWord(VarPtr(overlapped.Offset), offset)
     303                Dim ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
     304                If ret = FALSE Then
     305                    If GetLastError() = ERROR_IO_PENDING Then
     306                        GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
     307                    End If
     308                End If
     309                offset += Read
     310            Else
     311                ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL)
     312            End If
     313            Read = readBytes As Long
    318314        End If
    319315    End Function
    … …  
    326322                Select Case origin
    327323                    Case SeekOrigin.Begin
    328                         fileReadOverlapped.Offset=LODWORD(offset)
    329                         fileReadOverlapped.OffsetHigh=HIDWORD(offset)
    330                         fileWriteOverlapped.OffsetHigh=LODWORD(offset)
    331                         fileWriteOverlapped.OffsetHigh=HIDWORD(offset)
     324                        This.offset = offset
    332325                    Case SeekOrigin.Current
    333                         fileReadOverlapped.Offset+=LODWORD(offset)
    334                         fileReadOverlapped.OffsetHigh+=HIDWORD(offset)
    335                         fileWriteOverlapped.Offset+=LODWORD(offset)
    336                         fileWriteOverlapped.OffsetHigh+=HIDWORD(offset)
     326                        This.offset += offset
    337327                    Case SeekOrigin.End
    338                         fileReadOverlapped.Offset=LODWORD(This.Length()+offset)
    339                         fileReadOverlapped.OffsetHigh=HIDWORD(This.Length()+offset)
    340                         fileWriteOverlapped.Offset=LODWORD(This.Length()+offset)
    341                         fileWriteOverlapped.OffsetHigh=HIDWORD(This.Length()+offset)
     328                        This.offset = This.Length + offset
    342329                End Select
    343330            Else
    … …  
    379366
    380367    Sub Unlock(position As Int64, length As Int64)
    381     End Sub
     368        If position < 0 Then
     369            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
     370        ElseIf length < 0 Then
     371            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
     372        End If
     373        UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
     374            LODWORD(length As QWord), HIDWORD(length As QWord))
     375    End Sub
     376
    382377
    383378    Override Sub Write(buffer As *Byte, offset As Long, count As Long)
    384379        If This.CanWrite() Then
    385             Dim ret As DWord
    386             If This.IsAsync() Then
    387                 WriteFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(ret),This.fileWriteOverlapped)
    388                 While This.fileReadOverlapped.Internal=STATUS_PENDING
    389                 Wend
    390                 This.fileReadOverlapped.Offset+=LODWORD(ret)
    391                 This.fileReadOverlapped.OffsetHigh+=HIDWORD(ret)
    392                 This.fileWriteOverlapped.Offset+=LODWORD(ret)
    393                 This.fileWriteOverlapped.OffsetHigh+=HIDWORD(ret)
    394             Else
    395                 WriteFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(ret),ByVal NULL)
     380            Dim writeBytes As DWord
     381            If This.IsAsync() Then
     382                Dim overlapped As OVERLAPPED
     383                SetQWord(VarPtr(overlapped.Offset), offset)
     384                Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
     385                If ret = FALSE Then
     386                    If GetLastError() = ERROR_IO_PENDING Then
     387                        GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
     388                    End If
     389                End If
     390                offset += writeBytes
     391            Else
     392                WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
    396393            End If
    397394        End If

  • trunk/Include/Classes/System/IO/Path.ab

    r296 r388  
    1010Class Path
    1111Public
    12     Static AltDirectorySeparatorChar = &H2F As Char '/
    13     Static DirectorySeparatorChar = &H5C As Char    '\
    14     Static PathSeparator = &H3B As Char             ';
    15     Static VolumeSeparatorChar = &H3A As Char       ':
     12    Static AltDirectorySeparatorChar = &H2F As StrChar '/
     13    Static DirectorySeparatorChar = &H5C As StrChar    '\
     14    Static PathSeparator = &H3B As StrChar             ';
     15    Static VolumeSeparatorChar = &H3A As StrChar       ':
    1616
    1717    Static Function GetFileName(path As String) As String
    … …  
    121121
    122122    Static Function Combine(path1 As String, path2 As String) As String
    123         If path1.LastIndexOf(Chr$(VolumeSeparatorChar)) And path1.Length = 2 Then
     123        If path1.LastIndexOf(VolumeSeparatorChar) And path1.Length = 2 Then
    124124            Return path1 + path2
    125125        End If
    126126
    127         If path1.LastIndexOf(Chr$(DirectorySeparatorChar), ELM(path1.Length), 1) = -1 Then
     127        If path1.LastIndexOf(DirectorySeparatorChar, ELM(path1.Length), 1) = -1 Then
    128128            Return path1 + Chr$(DirectorySeparatorChar) + path2
    129129        Else
    … …  
    133133
    134134Private
    135     Static Function getExtensionPosition(ByRef path As String) As Long
     135    Static Function getExtensionPosition(path As String) As Long
    136136        Dim lastSepPos = getLastSeparatorPosision(path) As Long
    137         getExtensionPosition = path.LastIndexOf(".", ELM(path.Length), path.Length - lastSepPos)
     137        If lastSepPos = -1 Then
     138            lastSepPos = 0
     139        End If
     140        getExtensionPosition = path.LastIndexOf(Asc("."), ELM(path.Length), path.Length - lastSepPos)
    138141    End Function
    139142
    140     Static Function getLastSeparatorPosision(ByRef path As String) As Long
    141         Dim lastSepPos = path.LastIndexOf(Chr$(DirectorySeparatorChar)) As Long
     143    Static Function getLastSeparatorPosision(path As String) As Long
     144        Dim lastSepPos = path.LastIndexOf(DirectorySeparatorChar) As Long
    142145        If lastSepPos <> -1 Then Return lastSepPos
    143146
    144         lastSepPos = path.LastIndexOf(Chr$(VolumeSeparatorChar))
     147        lastSepPos = path.LastIndexOf(VolumeSeparatorChar)
    145148        Return lastSepPos
    146149    End Function

  • trunk/Include/Classes/System/IO/Stream.ab

    r381 r388  
    1010Public
    1111    Virtual Sub ~Stream()
    12         This.Close()
     12        This.Dispose(False)
    1313    End Sub
    1414Public
    … …  
    4949    End Function
    5050    Virtual Sub Close()
    51         This.Dispose()
     51        Dispose(True)
    5252    End Sub
     53    Virtual Sub Dispose()
     54        Dispose(True)
     55    End Sub
     56    Virtual Sub Dispose(disposing As Boolean):  End Sub
    5357    Virtual Function EndRead(ByRef asyncResult As System.IAsyncResult) As Long: End Function
    5458    Virtual Sub EndWrite(ByRef asyncResult As System.IAsyncResult): End Sub

  • trunk/Include/Classes/System/Runtime/InteropServices/GCHandle.ab

    r340 r388  
    3636
    3737    Static Function FromIntPtr(ip As LONG_PTR) As GCHandle
     38        If ip = 0 Then
     39            Throw New InvalidOperationException("GCHandle.FromIntPtr: ip is 0.")
     40        End If
    3841        FromIntPtr = New GCHandle
    3942        FromIntPtr.handle = ip As VoidPtr

  • trunk/Include/Classes/System/String.ab

    r383 r388  
    6161        Sub String(initStr As PCWSTR, start As Long, length As Long)
    6262            If start < 0 Or length Or start + length < 0 Then
    63                 'Throw New ArgumentOutOfRangeException
     63                Throw New ArgumentOutOfRangeException("String constractor: One or more arguments are out of range value.", "start or length or both")
    6464            End If
    6565            validPointerCheck(initStr + start, length)
    … …  
    7878
    7979        Sub String(initStr As PCSTR, start As Long, length As Long)
    80             If start < 0 Or length Or start + length < 0 Then
    81                 'Throw New ArgumentOutOfRangeException
     80            If start < 0 Or length < 0 Then
     81                Throw New ArgumentOutOfRangeException("String constructor: One or more arguments are out of range value.", "start or length or both")
    8282            End If
    8383            validPointerCheck(initStr + start, length)
    … …  
    9797        End Sub
    9898
    99         Sub String(sb As System.Text.StringBuilder)
     99        Sub String(sb As Text.StringBuilder)
    100100            Chars = StrPtr(sb)
    101101            m_Length = sb.Length
    … …  
    246246
    247247        Function CompareTo(y As Object) As Long
    248             Dim s = y As String
    249     '       If y is not String Then
    250     '           Throw New ArgumentException
    251     '       End If
     248            If Not Object.Equals(This.GetType(), y.GetType()) Then
     249                Throw New ArgumentException("String.CompareTo: An argument is out of range value.", "y")
     250            End If
    252251            Return CompareTo(y As String)
    253252        End Function
    … …  
    348347        Const Function Contains(s As String) As Boolean
    349348            If Object.ReferenceEquals(s, Nothing) Then
    350                 'Throw New ArgumentNullException
    351             End If
    352             Return IndexOf(s, 0, m_Length) >= 0
     349                Throw New ArgumentNullException("String.Contains: An argument is out of range value.", "s")
     350            ElseIf s = "" Then
     351                Return True
     352            Else
     353                Return IndexOf(s, 0, m_Length) >= 0
     354            End If
    353355        End Function
    354356
    … …  
    385387            rangeCheck(startIndex, count)
    386388            If Object.ReferenceEquals(s, Nothing) Then
    387                 'Throw New ArgumentNullException
    388                 Debug
     389                Throw New ArgumentNullException("String.IndexOf: An argument is out of range value.", "s")
    389390            End If
    390391
    … …  
    405406        End Function
    406407
     408        Const Function LastIndexOf(c As StrChar) As Long
     409            Return lastIndexOf(c, m_Length - 1, m_Length)
     410        End Function
     411
     412        Const Function LastIndexOf(c As StrChar, start As Long) As Long
     413            rangeCheck(start)
     414            Return lastIndexOf(c, start, start + 1)
     415        End Function
     416
     417        Const Function LastIndexOf(c As StrChar, start As Long, count As Long) As Long
     418            rangeCheck(start)
     419            Dim lastFindPos = start - (count - 1)
     420            If Not (m_Length > lastFindPos And lastFindPos >= 0) Then
     421                Throw New ArgumentOutOfRangeException("String.LastIndexOf: An argument is out of range value.", "count")
     422            End If
     423            Return lastIndexOf(c, start, count)
     424        End Function
     425    Private
     426        Const Function lastIndexOf(c As StrChar, start As Long, count As Long) As Long
     427            Dim lastFindPos = start - (count - 1)
     428            Dim i As Long
     429            For i = start To lastFindPos Step -1
     430                If Chars[i] = c Then
     431                    Return i
     432                End If
     433            Next
     434            Return -1
     435        End Function
     436
     437    Public
    407438        Const Function LastIndexOf(s As String) As Long
    408439            Return LastIndexOf(s, m_Length - 1, m_Length)
    … …  
    413444        End Function
    414445
    415         Const Function LastIndexOf(s As String, startIndex As Long, count As Long) As Long
     446        Const Function LastIndexOf(s As String, start As Long, count As Long) As Long
    416447            If Object.ReferenceEquals(s, Nothing) Then
    417                 'Throw New ArgumentNullException
    418                 Debug
    419             End If
    420 
    421             If startIndex < 0 Or startIndex > m_Length - 1 Or _
    422                 count < 0 Or count > startIndex + 2 Then
    423                 'Throw New ArgumentOutOfRangeException
    424                 Debug
    425             End If
    426             Dim length = s.Length
     448                Throw New ArgumentNullException("String.LastIndexOf: An argument is out of range value.", "s")
     449            End If
     450
     451            If start < 0 Or start > m_Length - 1 Or _
     452                count < 0 Or count > start + 2 Then
     453                Throw New ArgumentOutOfRangeException("String.LastIndexOf: One or more arguments are out of range value.", "start or count or both")
     454            End If
     455            Dim length = s.m_Length
    427456            If length > m_Length Then Return -1
    428             If length = 0 Then Return startIndex
     457            If length = 0 Then Return start
    429458
    430459            Dim i As Long, j As Long
    431             For i = startIndex To  startIndex - count + 1 Step -1
     460            For i = start To  start - count + 1 Step -1
    432461                For j = length - 1 To 0 Step -1
    433462                    If Chars[i + j] = s[j] Then
    … …  
    450479
    451480        Const Function Insert(startIndex As Long, text As String) As String
    452             Dim sb = New System.Text.StringBuilder(This)
     481            Dim sb = New Text.StringBuilder(This)
    453482            sb.Insert(startIndex, text)
    454483            Return sb.ToString
    … …  
    471500
    472501        Const Function Remove(startIndex As Long, count As Long) As String
    473             Dim sb = New System.Text.StringBuilder(This)
     502            Dim sb = New Text.StringBuilder(This)
    474503            sb.Remove(startIndex, count)
    475504            Remove = sb.ToString
    … …  
    486515
    487516        Const Function Replace(oldChar As StrChar, newChar As StrChar) As String
    488             Dim sb = New System.Text.StringBuilder(This)
     517            Dim sb = New Text.StringBuilder(This)
    489518            sb.Replace(oldChar, newChar)
    490519            Replace = sb.ToString
    … …  
    492521
    493522        Const Function Replace(oldStr As String, newStr As String) As String
    494             Dim sb = New System.Text.StringBuilder(This)
     523            Dim sb = New Text.StringBuilder(This)
    495524            sb.Replace(oldStr, newStr)
    496525            Return sb.ToString
    … …  
    498527
    499528        Const Function ToLower() As String
    500             Dim sb = New System.Text.StringBuilder(m_Length)
     529            Dim sb = New Text.StringBuilder(m_Length)
    501530            sb.Length = m_Length
    502531            Dim i As Long
    503532            For i = 0 To ELM(m_Length)
    504                 sb[i] = _System_ASCII_ToLower(Chars[i])
     533                sb[i] = ActiveBasic.CType.ToLower(Chars[i])
    505534            Next
    506535            Return sb.ToString
    … …  
    508537
    509538        Const Function ToUpper() As String
    510             Dim sb = New System.Text.StringBuilder(m_Length)
     539            Dim sb = New Text.StringBuilder(m_Length)
    511540            sb.Length = m_Length
    512541            Dim i As Long
    513542            For i = 0 To ELM(m_Length)
    514                 sb[i] = _System_ASCII_ToUpper(Chars[i])
     543                sb[i] = ActiveBasic.CType.ToUpper(Chars[i])
    515544            Next
    516545            Return sb.ToString
    … …  
    539568            Dim size = m_Length
    540569#endif
    541             Return _System_GetHashFromWordArray(Chars As *Word, size) Xor size
     570            Return _System_GetHashFromWordArray(Chars As *Word, size) Xor m_Length
    542571        End Function
    543572
    … …  
    548577        Function PadLeft(total As Long, c As StrChar) As String
    549578            If total < 0 Then
    550                 'Throw New ArgumentException
     579                Throw New ArgumentOutOfRangeException("String.PadLeft: An arguments is out of range value.", "total")
    551580            End If
    552581            If total >= m_Length Then
    553582                Return This
    554583            End If
    555             Dim sb = New System.Text.StringBuilder(total)
     584            Dim sb = New Text.StringBuilder(total)
    556585            sb.Append(c, total - m_Length)
    557586            sb.Append(This)
    … …  
    565594        Function PadRight(total As Long, c As StrChar) As String
    566595            If total < 0 Then
    567                 'Throw New ArgumentException
     596                Throw New ArgumentOutOfRangeException("String.PadRight: An arguments is out of range value.", "total")
    568597            End If
    569598            If total >= m_Length Then
    570599                Return This
    571600            End If
    572             Dim sb = New System.Text.StringBuilder(total)
     601            Dim sb = New Text.StringBuilder(total)
    573602            sb.Append(This)
    574603            sb.Append(c, total - m_Length)
    … …  
    596625        Const Sub rangeCheck(index As Long)
    597626            If index < 0 Or index > m_Length Then
    598                 Debug 'ArgumentOutOfRangeException
     627                Throw New ArgumentOutOfRangeException("String: An arguments is out of range value.", "index")
    599628            End If
    600629        End Sub
    … …  
    602631        Const Sub rangeCheck(start As Long, length As Long)
    603632            If start < 0 Or start > This.m_Length Or length < 0 Then
    604                 Debug 'ArgumentOutOfRangeException
     633                Throw New ArgumentOutOfRangeException("String: One or more arguments are out of range value.", "start or length or both")
    605634            End If
    606635        End Sub

  • trunk/Include/Classes/System/Text/StringBuilder.ab

    r385 r388  
    128128                Return This
    129129            Else
    130                 Throw New ArgumentNullException("StringBuilder.Append: An argument was null", "s")
     130                Throw New ArgumentNullException("StringBuilder.Append: An argument is null", "s")
    131131            End If
    132132        ElseIf startIndex < 0 Or count < 0 Then
    133             Throw New ArgumentOutOfRangeException("StringBuilder.Append: One or more arguments have out of range value.", "startIndex or count or both")
     133            Throw New ArgumentOutOfRangeException("StringBuilder.Append: One or more arguments are out of range value.", "startIndex or count or both")
    134134        End If
    135135        appendCore(s, startIndex, count)
    … …  
    169169    Const Sub CopyTo(sourceIndex As Long, ByRef dest[] As StrChar, destIndex As Long, count As Long)
    170170        If dest = 0 Then
    171             Throw New ArgumentNullException("StringBuilder.CopyTo: An argument was null", "sourceIndex")
     171            Throw New ArgumentNullException("StringBuilder.CopyTo: An argument is null", "sourceIndex")
    172172        ElseIf size < sourceIndex + count Or sourceIndex < 0 Or destIndex < 0 Or count < 0 Then
    173             Throw New ArgumentOutOfRangeException("StringBuilder.CopyTo: One or more arguments have out of range value.", "startIndex or count or both")
     173            Throw New ArgumentOutOfRangeException("StringBuilder.CopyTo: One or more arguments are out of range value.", "startIndex or count or both")
    174174        End If
    175175
    … …  
    179179    Function EnsureCapacity(c As Long) As Long
    180180        If c < 0 Or c > MaxCapacity Then
    181             Throw New ArgumentOutOfRangeException("StringBuilder.Append: An argument was out of range value.", "c")
     181            Throw New ArgumentOutOfRangeException("StringBuilder.Append: An argument is out of range value.", "c")
    182182        ElseIf c > Capacity Then
    183183            Dim p = GC_malloc_atomic((c + 1) * SizeOf (StrChar)) As *StrChar
    … …  
    291291        rangeCheck(index)
    292292        If n < 0 Then
    293             Throw New ArgumentOutOfRangeException("StringBuilder.Insert: An argument was out of range value.", "n")
     293            Throw New ArgumentOutOfRangeException("StringBuilder.Insert: An argument is out of range value.", "n")
    294294        End If
    295295        Dim len = x.Length
    … …  
    310310        rangeCheck(i)
    311311        If x = 0 Then
    312             Throw New ArgumentNullException("StringBuilder.Insert: An argument was null", "x")
     312            Throw New ArgumentNullException("StringBuilder.Insert: An argument is null", "x")
    313313        ElseIf index < 0 Or count < 0 Then
    314             Throw New ArgumentOutOfRangeException("StringBuilder.Append: One or more arguments have out of range value.", "index or count or both")
     314            Throw New ArgumentOutOfRangeException("StringBuilder.Append: One or more arguments are out of range value.", "index or count or both")
    315315        End If
    316316
    … …  
    381381    Sub replaceCore(oldStr As String, newStr As String, start As Long, count As Long)
    382382        If ActiveBasic.IsNothing(oldStr) Then
    383             Throw New ArgumentNullException("StringBuilder.Replace: An argument was null", "oldStr")
     383            Throw New ArgumentNullException("StringBuilder.Replace: An argument is null", "oldStr")
    384384        ElseIf oldStr.Length = 0 Then
    385385            Throw New ArgumentException("StringBuilder.Replace: The argument 'oldStr' is empty string. ", "oldStr")
    … …  
    428428    Sub Capacity(c As Long)
    429429        If c < size Or c > MaxCapacity Then 'sizeとの比較でcが負の場合も対応
    430             Throw New ArgumentOutOfRangeException("StringBuilder.Append: An argument have out of range value.", "c")
     430            Throw New ArgumentOutOfRangeException("StringBuilder.Capacity: An argument is out of range value.", "c")
    431431        End If
    432432        EnsureCapacity(c)
    … …  
    435435    Const Function Chars(i As Long) As StrChar
    436436        If i >= Length Or i < 0 Then
    437             Throw New IndexOutOfRangeException("StringBuilder.Chars: The index argument 'i' have out of range value.")
     437            Throw New IndexOutOfRangeException("StringBuilder.Chars: The index argument 'i' is out of range value.")
    438438        End If
    439439        Return chars[i]
    … …  
    442442    Sub Chars(i As Long, c As StrChar)
    443443        If i >= Length Or i < 0 Then
    444             Throw New ArgumentOutOfRangeException("StringBuilder.Chars: An argument have out of range value.", "i")
     444            Throw New ArgumentOutOfRangeException("StringBuilder.Chars: An argument is out of range value.", "i")
    445445        End If
    446446        chars[i] = c
    … …  
    474474    Sub initialize(capacity As Long, maxCapacity = LONG_MAX As Long)
    475475        If capacity < 0 Or maxCapacity < 1 Or maxCapacity < capacity Then
    476             Throw New ArgumentOutOfRangeException("StringBuilder constructor: One or more arguments have out of range value.", "capacity or maxCapacity or both")
     476            Throw New ArgumentOutOfRangeException("StringBuilder constructor: One or more arguments are out of range value.", "capacity or maxCapacity or both")
    477477        End If
    478478
    … …  
    506506    Sub rangeCheck(index As Long)
    507507        If index < 0 Or index > size Then
    508             Throw New ArgumentOutOfRangeException("StringBuilder: Index argument has out of range value.")
     508            Throw New ArgumentOutOfRangeException("StringBuilder: Index argument is out of range value.")
    509509        End If
    510510    End Sub
    … …  
    517517        'length < 0は判定に入っていないことに注意
    518518        If startIndex < 0 Or count < 0 Or startIndex + count > length Then
    519             Throw New ArgumentOutOfRangeException("StringBuilder: One or more arguments have out of range value.", "startIndex or count or both")
     519            Throw New ArgumentOutOfRangeException("StringBuilder: One or more arguments are out of range value.", "startIndex or count or both")
    520520        End If
    521521    End Sub

  • trunk/Include/Classes/System/Threading/WaitHandle.ab

    r381 r388  
    3838    End Sub
    3939
    40     Override Sub Dispose()
     40    Virtual Sub Dispose()
    4141        Dim hDisposing = InterlockedExchangePointer(h, 0)
    4242        If hDisposing <> 0 Then
    … …  
    4949    End Function
    5050
    51     Function WaitOne(millisecondsTimeout As Long, exitContext As BOOL) As Boolean
     51    Function WaitOne(millisecondsTimeout As Long, exitContext As Boolean) As Boolean
    5252        Return WaitHandle.AfterWait(WaitForSingleObject(h, millisecondsTimeout As DWord), 1)
    5353    End Function
    … …  
    8080
    8181Public
    82     Static Function SignalAndWait(toSignal As WaitHandle, toWaitOn As WaitHandle, millisecondsTimeout As Long, exitContext As BOOL) As Boolean
     82    Static Function SignalAndWait(toSignal As WaitHandle, toWaitOn As WaitHandle, millisecondsTimeout As Long, exitContext As Boolean) As Boolean
    8383        Dim pSignalObjectAndWait = GetProcAddress(GetModuleHandle("Kernel32.dll"), "SignalObjectAndWait") As Detail.PFNSignalObjectAndWait
    8484        If pSignalObjectAndWait = 0 Then
    85             ' PlatformNotSupportedException
    86             Debug
    87             ExitThread(-1)
     85            Throw New PlatformNotSupportedException("WaitHandle.SignalAndWait: This platform doesn't supoort this operation.")
    8886        End If
    8987        Return WaitHandle.AfterWait(pSignalObjectAndWait(toSignal.Handle, toWaitOn.Handle, millisecondsTimeout As DWord, FALSE), 1)

  • trunk/Include/Classes/System/Windows/Forms/Application.ab

    r319 r388  
    2727        Return System.IO.Path.GetDirectoryName( ExecutablePath )
    2828    End Function
     29
     30    Static Sub ExitThread()
     31        PostQuitMessage(0)
     32    End Sub
    2933End Class
    30 
    3134   
    3235End Namespace

  • trunk/Include/Classes/System/Windows/Forms/Control.ab

    r381 r388  
    44#define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
    55
     6/*
    67#require <Classes/System/Windows/Forms/misc.ab>
    78#require <Classes/System/Windows/Forms/CreateParams.ab>
    … …  
    1112#require <Classes/System/Math.ab>
    1213#require <Classes/System/Threading/WaitHandle.ab>
     14*/
    1315#require <Classes/System/Drawing/Color.ab>
    1416#require <Classes/System/Drawing/Point.ab>
    1517#require <Classes/System/Drawing/Size.ab>
    1618#require <Classes/System/Drawing/Rectangle.ab>
     19/*
    1720#require <Classes/System/Runtime/InteropServices/GCHandle.ab>
    1821#require <Classes/ActiveBasic/Windows/WindowHandle.sbp>
    1922#require <Classes/ActiveBasic/Strings/Strings.ab>
    20 
     23*/
    2124Namespace System
    2225Namespace Windows
    … …  
    143146        End If
    144147    End Function
    145 
     148/* BoundsSpecifiedが使用不能なのでコメントアウト
    146149    Sub Bounds(r As Rectangle)
    147150        SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All)
    148151    End Sub
    149 
     152*/
    150153    Const Function Location() As Point
    151154        Return Bounds.Location
    152155    End Function
    153 
     156/*
    154157    Sub Location(p As Point)
    155158        SetBoundsCore(p.X, p.Y, 0, 0, BoundsSpecified.Location)
    156159    End Sub
    157 
     160*/
    158161    Const Function Size() As Size
    159162        Return Bounds.Size
    160163    End Function
    161 
     164/*
    162165    Sub Size(s As Size)
    163166        SetBoundsCore(0, 0, s.Width, s.Height, BoundsSpecified.Size)
    … …  
    171174        Return ClientRectangle.Size
    172175    End Function
    173 
     176*/
    174177    Const Function Left() As Long
    175178        Dim b = Bounds
    176179        Return b.Left
    177180    End Function
    178 
     181/*
    179182    Sub Left(l As Long)
    180183        SetBoundsCore(l, 0, 0, 0, BoundsSpecified.X)
    181184    End Sub
    182 
     185*/
    183186    Const Function Top() As Long
    184187        Dim b = Bounds
    185188        Return b.Top
    186189    End Function
    187 
     190/*
    188191    Sub Top(t As Long)
    189192        SetBoundsCore(0, t, 0, 0, BoundsSpecified.Y)
    190193    End Sub
    191 
     194*/
    192195    Const Function Width() As Long
    193196        Dim b = Bounds
    194197        Return b.Width
    195198    End Function
    196 
     199/*
    197200    Sub Width(w As Long)
    198201        SetBoundsCore(0, 0, w, 0, BoundsSpecified.Width)
    199202    End Sub
    200 
     203*/
    201204    Const Function Height() As Long
    202205        Dim b = Bounds
    203206        Return b.Height
    204207    End Function
    205 
     208/*
    206209    Sub Height(h As Long)
    207210        SetBoundsCore(0, 0, 0, h, BoundsSpecified.Height)
    208211    End Sub
    209 
     212*/
    210213    Const Function Right() As Long
    211214        Dim b = Bounds
    … …  
    273276
    274277    Sub Control()
    275         Debug
    276278        Dim sz = DefaultSize()
    277         Control("", 100, 100, sz.Width, sz.Height)
     279        init(Nothing, "", 100, 100, sz.Width, sz.Height)
    278280    End Sub
    279281
    280282    Sub Control(text As String)
    281283        Dim sz = DefaultSize()
    282         Control(text, 100, 100, sz.Width, sz.Height)
     284        init(Nothing, text, 100, 100, sz.Width, sz.Height)
    283285    End Sub
    284286
    285287    Sub Control(parent As Control, text As String)
    286288        Dim sz = DefaultSize()
    287         Control(parent, text, 100, 100, sz.Width, sz.Height)
     289        init(parent, text, 100, 100, sz.Width, sz.Height)
    288290    End Sub
    289291
    290292    Sub Control(text As String, left As Long, top As Long, width As Long, height As Long)
    291         This.text = text
    292         bkColor = DefaultBackColor
     293        init(Nothing, text, left, top, width, height)
    293294    End Sub
    294295
    295296    Sub Control(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long)
     297        init(parent, text, left, top, width, height)
     298    End Sub
     299
     300Private
     301
     302    Sub init(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long)
    296303        This.parent = parent
    297         Control(text, left, top, width, height)
    298     End Sub
     304'       CreateControl()
     305    End Sub
     306   
    299307
    300308    '---------------------------------------------------------------------------
    301309    ' Destractor
    302 
     310Public
    303311    Virtual Sub ~Control()
    304312        If Not Object.ReferenceEquals(wnd, Nothing) Then
    … …  
    398406
    399407    Virtual Function DefaultSize() As Size
    400         Dim s As Size(300, 300)
    401         Return s
     408        Return New Size(300, 300)
    402409    End Function
    403410
    … …  
    411418    ' Protected Methods
    412419    Virtual Sub CreateHandle()
     420        Debug
     421        If Not Object.ReferenceEquals(wnd, Nothing) Then
     422            If wnd.HWnd <> 0 Then
     423                Exit Sub
     424            End If
     425        End If
     426       
    413427        Dim createParams = CreateParams()
    414428        Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(This)
    415429        TlsSetValue(tlsIndex, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch) As VoidPtr)
    416430        With createParams
    417             Dim hwndParent = 0 As HWND
    418             If Not Object.ReferenceEquals(parent, Nothing) Then
    419                 hwndParent = parent.Handle
    420             End If
    421431            Dim pText As PCTSTR
    422432            If String.IsNullOrEmpty(text) Then
    … …  
    427437
    428438            If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, pText, .Style, _
    429                 CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
    430                 hwndParent, 0, hInstance, 0) = 0 Then
     439                .X, .Y, .Width, .Height, _
     440                .Parent, 0, hInstance, 0) = 0 Then
    431441                ' Error
    432442                Dim buf[1023] As TCHAR
    433443                wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError())
    434444                OutputDebugString(buf)
     445
     446                gch.Free()
    435447'               Debug
    436448                ExitThread(0)
    437449            End If
    438450        End With
    439         gch.Free()
     451       
    440452    End Sub
    441453
    … …  
    475487                Case WM_DESTROY
    476488                    OnHandleDestroyed(System.EventArgs.Empty)
     489
     490                Case WM_LBUTTONDOWN
     491                    Goto *ButtonDown
     492*ButtonDown
    477493                Case Else
    478494                    DefWndProc(m)
    … …  
    521537    End Sub
    522538
    523     Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub
     539'   Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub
    524540    Virtual Sub OnEnabledChanged(e As System.EventArgs) : End Sub
    525541    Virtual Sub OnBackColorChanged(e As System.EventArgs) : End Sub
    … …  
    582598            .Style = WS_OVERLAPPEDWINDOW
    583599            .ExStyle = WS_EX_APPWINDOW
     600            .Caption = String.Empty
     601            .X = 0
     602            .Y = 0
     603            .Width = 0
     604            .Height = 0
    584605        End With
    585606    End Sub
    … …  
    608629            rThis.wnd = New ActiveBasic.Windows.WindowHandle(hwnd)
    609630            SetWindowLongPtr(hwnd, GWLP_THIS, gchValue)
     631        ElseIf msg = WM_NCDESTROY Then
     632            Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS))
     633             gch.Free()
    610634        End If
    611635

  • trunk/Include/Classes/System/Windows/Forms/Message.ab

    r303 r388  
    44#define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__
    55
    6 #require <windows.sbp>
     6'#require <windows.sbp>
    77
    88Namespace System
    … …  
    6565    End Function
    6666
    67     Const Function Operator ==(x As Message) As BOOL
     67    Const Function Operator ==(x As Message) As Boolean
    6868        Return Equals(x)
    6969    End Function
    7070
    71     Const Function Operator <>(x As Message) As BOOL
     71    Const Function Operator <>(x As Message) As Boolean
    7272        Return Not Equals(x)
    7373    End Function

  • trunk/Include/Classes/System/Windows/Forms/MessageBox.ab

    r319 r388  
    11'Classes/System/Windows/Forms/MessageBox.ab
    22
    3 #require <Classes/System/Windows/Forms/misc.ab>
    4 #require <Classes/ActiveBasic/Windows/Windows.ab>
     3'#require <Classes/System/Windows/Forms/misc.ab>
     4'#require <Classes/ActiveBasic/Windows/Windows.ab>
    55
    66Namespace System

  • trunk/Include/Classes/System/Windows/Forms/PaintEventArgs.ab

    r282 r388  
    33#ifndef __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__
    44#define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__
    5 
    6 #require <Classes/System/misc.ab>
    75
    86Namespace System

  • trunk/Include/Classes/System/Windows/Forms/misc.ab

    r303 r388  
    99
    1010Interface IWin32Window
    11     /*Const*/ Function Handle() As HWND
     11    Function Handle() As HWND
    1212End Interface
    1313
     14TypeDef BoundsSpecified = Long
     15/*
    1416Enum BoundsSpecified
    1517    None = &h0
    … …  
    2224    All = BoundsSpecified.Location Or BoundsSpecified.Size
    2325End Enum
    24 
     26*/
     27
     28/*
    2529Enum Keys
    2630    LButton = VK_LBUTTON
    … …  
    208212End Enum
    209213
     214Enum MouseButtons
     215    None = 0
     216    Left = &h00100000
     217    Right = &h00200000
     218    Middle = &h00400000
     219    XButton1 = &h00800000
     220    XButton2 = &h01000000
     221End Enum
     222*/
     223
     224TypeDef DialogResult = DWord
     225TypeDef MouseButtons = DWord
     226
     227Class MouseEventArgs
     228    Inherits System.EventArgs
     229Public
     230
     231    Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long)
     232        MouseButton = button
     233        Clicks = clicks
     234        X = x
     235        Y = y
     236        Delta = delta
     237    End Sub
     238
     239    Const MouseButton As MouseButtons
     240    Const Clicks As Long
     241    Const X As Long
     242    Const Y As Long
     243    Const Delta As Long
     244End Class
     245
    210246End Namespace 'Forms
    211247End Namespace 'Widnows

  • trunk/Include/Classes/index.ab

    r385 r388  
    22#require "./ActiveBasic/Core/InterfaceInfo.ab"
    33#require "./ActiveBasic/Core/TypeInfo.ab"
     4#require "./ActiveBasic/CType/CType.ab"
    45#require "./ActiveBasic/Math/Math.ab"
    56#require "./ActiveBasic/Strings/SPrintF.ab"

  • trunk/Include/api_system.sbp

    r369 r388  
    567567Declare Function GetOverlappedResult Lib "kernel32" (
    568568    hFile As HANDLE,
    569     pOverlapped As *OVERLAPPED,
    570     pNumberOfBytesTransferred AS *DWord,
     569    ByRef Overlapped As OVERLAPPED,
     570    ByRef pNumberOfBytesTransferred As DWord,
    571571    bWait As BOOL
    572572) As BOOL
    … …  
    769769    NumberOfArguments As DWord,
    770770    pArguments As *ULONG_PTR)
    771 Declare Function ReadFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToRead As DWord, lpNumberOfBytesRead As DWordPtr, ByRef lpOverlapped As OVERLAPPED) As BOOL
     771Declare Function ReadFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToRead As DWord, lpNumberOfBytesRead As *DWord, ByRef Overlapped As OVERLAPPED) As BOOL
    772772Declare Function ReadProcessMemory Lib "Kernel32"  (hProcess As HANDLE, lpBaseAddress As VoidPtr, lpBuffer As VoidPtr, nSize As SIZE_T, lpNumberOfBytesRead As *SIZE_T) As BOOL
    773773Declare Function ReleaseMutex Lib "kernel32" (hMutex As HANDLE) As BOOL
    … …  
    874874) As Long
    875875
    876 Declare Function WriteFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToWrite As DWord, lpNumberOfBytesWritten As DWordPtr, ByRef lpOverlapped As OVERLAPPED) As BOOL
     876Declare Function WriteFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToWrite As DWord, lpNumberOfBytesWritten As *DWord, ByRef pOverlapped As OVERLAPPED) As BOOL
    877877Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As VoidPtr, dwLength As DWord)
    878878

  • trunk/Include/basic/function.sbp

    r385 r388  
    7878
    7979Function pow(x As Double, y As Double) As Double
    80     If -LONG_MAX<=y and y<=LONG_MAX and y=CDbl(Int(y)) Then
    81         pow=ipow(x,y As Long)
     80'   If -LONG_MAX<=y and y<=LONG_MAX and y=CDbl(Int(y)) Then
     81    If y = (y As Long) Then
     82        pow = ipow(x, y As Long)
     83    ElseIf x>0 Then
     84        pow = Exp(y * Log(x))
    8285        Exit Function
    83     End If
    84 
    85     If x>0 Then
    86         pow=Exp(y*Log(x))
    87         Exit Function
    88     End If
    89 
    90     If x<>0 or y<=0 Then
    91         'error
    92     End If
    93 
    94     pow=0
     86    ElseIf x<>0 or y<=0 Then
     87        pow = ActiveBasic.Math.Detail.GetNaN()
     88    Else
     89        pow = 0
     90    End If
    9591End Function
    9692
    … …  
    272268        Return New String(c As StrChar, 1)
    273269    ElseIf c < &h10FFFF Then
    274         Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As StrChar
     270        Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As WCHAR
    275271        Return New String(t, 2)
    276272    Else
    … …  
    306302End Function
    307303
    308 Dim _System_HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte
    309 
    310 Function _System_Hex(x As DWord, zeroSuppress As Boolean) As String
    311     Dim s[7] As StrChar
    312     Dim i As Long
    313     For i = 0 To ELM(Len (s) \ SizeOf (StrChar))
    314         s[i] = _System_HexadecimalTable[x >> 28] As StrChar
    315         x <<= 4
    316     Next
    317     If zeroSuppress Then
    318         Dim i As Long
    319         For i = 0 To 6
    320             If s[i] <> &h30 Then 'Asc("0")
    321                 Exit For
    322             End If
    323         Next
    324         Return New String(VarPtr(s[i]) As *StrChar, Len (s) \ SizeOf (StrChar) - i)
    325     Else
    326         Return New String(s As *StrChar, Len (s) \ SizeOf (StrChar))
    327     End If
    328 End Function
    329 
    330304Function Hex$(x As DWord) As String
    331     Hex$ = _System_Hex(x, True)
     305    Imports ActiveBasic.Strings.Detail
     306    Hex$ = FormatIntegerX(x, 1, 0, None)
    332307End Function
    333308
    334309Function Hex$(x As QWord) As String
    335     If HIDWORD(x) = 0 Then
    336         Hex$ = _System_Hex(LODWORD(x), True)
    337     Else
    338         Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
    339     End If
     310    Imports ActiveBasic.Strings.Detail
     311    Hex$ = FormatIntegerLX(x, 1, 0, None)
    340312End Function
    341313
    … …  
    391363End Function
    392364
    393 Const _System_MaxFigure_Oct_QW = 22 As DWord 'QWORD_MAX = &o1,777,777,777,777,777,777,777
    394365Function Oct$(n As QWord) As String
    395     Dim s[ELM(_System_MaxFigure_Oct_QW)] As StrChar
    396     Dim i = ELM(_System_MaxFigure_Oct_QW) As Long
    397     Do
    398         s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
    399         n >>= 3
    400         If n = 0 Then
    401             Return New String(s + i, _System_MaxFigure_Oct_QW - i)
    402         End If
    403         i--
    404     Loop
    405 End Function
    406 
    407 Const _System_MaxFigure_Oct_DW = 11 As DWord 'DWORD_MAX = &o37,777,777,777
     366    Imports ActiveBasic.Strings.Detail
     367    Oct$ = FormatIntegerLO(n, 1, 0, None)
     368End Function
     369
    408370Function Oct$(n As DWord) As String
    409     Dim s[ELM(_System_MaxFigure_Oct_DW)] As StrChar
    410     Dim i = ELM(_System_MaxFigure_Oct_DW) As Long
    411     Do
    412         s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
    413         n >>= 3
    414         If n = 0 Then
    415             Return New String(s + i, _System_MaxFigure_Oct_DW - i)
    416         End If
    417         i--
    418     Loop
     371    Imports ActiveBasic.Strings.Detail
     372    Oct$ = FormatIntegerO(n, 1, 0, None)
    419373End Function
    420374
    … …  
    493447
    494448Function Str$(dbl As Double) As String
    495     If ActiveBasic.Math.IsNaN(dbl) Then
     449    Imports ActiveBasic.Math
     450    Imports ActiveBasic.Strings
     451    If IsNaN(dbl) Then
    496452        Return "NaN"
    497     ElseIf ActiveBasic.Math.IsInf(dbl) Then
     453    ElseIf IsInf(dbl) Then
    498454        If dbl > 0 Then
    499455            Return "Infinity"
    … …  
    521477        buffer[i] = Asc(".")
    522478        i++
    523         ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14 As SIZE_T)
     479        ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14 As SIZE_T)
    524480        i += 14
    525481        buffer[i] = 0
    526         Return MakeStr(buffer) + ActiveBasic.Strings.SPrintf("e%+03d", New System.Int32(dec - 1))
     482        Return MakeStr(buffer) + SPrintf("e%+03d", New System.Int32(dec - 1))
    527483    End If
    528484
    … …  
    637593    If String.IsNullOrEmpty(s) Then
    638594        Return New String(0 As StrChar, n)
    639             Else
     595    Else
    640596        Return New String(s[0], n)
    641597    End If
    … …  
    971927
    972928/*!
    973 @brief  ABオブジェクトを指すポインタをObject型へ変換。
     929@brief  ObjPtrの逆。ABオブジェクトを指すポインタをObject型へ変換。
    974930@author Egtra
    975931@date   2007/08/24
    … …  
    1012968End Function
    1013969
    1014 Function _System_ASCII_IsUpper(c As WCHAR) As Boolean
    1015     Return c As DWord - &h41 < 26 ' &h41 = Asc("A")
    1016 End Function
    1017 
    1018 Function _System_ASCII_IsUpper(c As SByte) As Boolean
    1019     Return _System_ASCII_IsUpper(c As Byte As WCHAR)
    1020 End Function
    1021 
    1022 Function _System_ASCII_IsLower(c As WCHAR) As Boolean
    1023     Return c As DWord - &h61 < 26 ' &h61 = Asc("a")
    1024 End Function
    1025 
    1026 Function _System_ASCII_IsLower(c As SByte) As Boolean
    1027     Return _System_ASCII_IsLower(c As Byte As WCHAR)
    1028 End Function
    1029 
    1030 Function _System_ASCII_ToLower(c As WCHAR) As WCHAR
    1031     If _System_ASCII_IsUpper(c) Then
    1032         Return c Or &h20
    1033     Else
    1034         Return c
    1035     End If
    1036 End Function
    1037 
    1038 Function _System_ASCII_ToLower(c As SByte) As SByte
    1039     Return _System_ASCII_ToLower(c As Byte As WCHAR) As Byte As SByte
    1040 End Function
    1041 
    1042 Function _System_ASCII_ToUpper(c As WCHAR) As WCHAR
    1043     If _System_ASCII_IsLower(c) Then
    1044         Return c And (Not &h20)
    1045     Else
    1046         Return c
    1047     End If
    1048 End Function
    1049 
    1050 Function _System_ASCII_ToUpper(c As SByte) As SByte
    1051     Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte
    1052 End Function
    1053 
    1054970Function _System_GetHashFromWordArray(p As *Word, n As SIZE_T) As Long
    1055971    Dim hash = 0 As DWord

  • trunk/Include/system/debug.sbp

    r259 r388  
    2929End Function
    3030
    31 Sub _DebugSys_Set_LONG_PTR(pPtr As VoidPtr, lpData As LONG_PTR)
    32 #ifdef _WIN64
    33     SetQWord(pPtr,lpData)
    34 #else
    35     SetDWord(pPtr,lpData)
    36 #endif
    37 End Sub
    38 
    3931Sub _DebugSys_StartProc(lpSpBase As ULONG_PTR, lpObp As ULONG_PTR)
    4032    Dim i As Long
    … …  
    5345        _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
    5446    End If
    55     _DebugSys_Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpObp)
    56     _DebugSys_Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpSpBase)
     47    Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpObp)
     48    Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR),lpSpBase)
    5749
    5850    _DebugSys_ProcNum[ThreadNum]=_DebugSys_ProcNum[ThreadNum]+1
    … …  
    7769        _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2)
    7870    End If
    79     _DebugSys_Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpObp)
    80     _DebugSys_Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpSpBase)
     71    Set_LONG_PTR(_DebugSys_lplpObp[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpObp)
     72    Set_LONG_PTR(_DebugSys_lplpSpBase[ThreadNum]+_DebugSys_ProcNum[ThreadNum]*SizeOf(ULONG_PTR), lpSpBase)
    8173End Sub
    8274

  • trunk/Include/system/exception.ab

    r375 r388  
    5757                End If
    5858            Else
    59                 If lstrcmp( paramName, ex.GetType().FullName ) = 0 Then
     59                If isCatchable(New String(paramName), ex.GetType()) Then
     60'               If lstrcmp( paramName, ex.GetType().FullName ) = 0 Then
    6061                    ' マッチしたとき
    6162                    Return codePos
    … …  
    6465        Wend
    6566        Return defaultCatchCodePos
     67    End Function
     68
     69    Function isCatchable(paramName As String, catchType As System.TypeInfo) As Boolean
     70        isCatchable = False
     71        While Not ActiveBasic.IsNothing(catchType)
     72            Dim catchTypeName = catchType.FullName
     73            If paramName = catchTypeName Then
     74                isCatchable = True
     75                Exit Function
     76            End If
     77            catchType = catchType.BaseType
     78        Wend
    6679    End Function
    6780End Class
    … …  
    114127
    115128            'TODO: 適切なエラー処理
    116             MessageBox( NULL, "例外", "", MB_OK or MB_ICONEXCLAMATION )
    117 
     129            MessageBox( NULL, "Catchされていない例外があります", NULL, MB_OK or MB_ICONEXCLAMATION )
     130            Debug
    118131            Return
    119132        End If
Note: See TracChangeset for help on using the changeset viewer.