Changeset 388
- Timestamp:
- Nov 25, 2007, 4:31:35 PM (17 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab
r386 r388 731 731 End Function 732 732 733 /* 734 @brief 0からFまでの文字を収めた表 735 @author egtra 736 */ 737 Dim HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte 738 733 739 /*! 734 740 @author Egtra … … 739 745 Dim x = xq As DWord 740 746 While x <> 0 741 buf[i] = _System_HexadecimalTable[x And &h0f]747 buf[i] = HexadecimalTable[x And &h0f] 742 748 x >>= 4 743 749 i-- … … 754 760 Dim i = MaxSizeLX 755 761 While x <> 0 756 buf[i] = _System_HexadecimalTable[x And &h0f]762 buf[i] = HexadecimalTable[x And &h0f] 757 763 x >>= 4 758 764 i-- … … 1270 1276 s.Append(FormatString(params[i] As String, precision, fieldWidth, flags)) 1271 1277 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)) 1273 1279 ' Case &h6e 'n 1274 1280 Case &h25 '% -
trunk/Include/Classes/System/Environment.ab
r337 r388 31 31 Static Function CurrentDirectory() As String 32 32 Dim size = GetCurrentDirectory(0, 0) 33 Dim p = _System_malloc(SizeOf (TCHAR) * size) As PCTSTR33 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PCTSTR 34 34 Dim len = GetCurrentDirectory(size, p) 35 35 If len < size Then 36 36 CurrentDirectory = New String(p, size As Long) 37 _System_free(p)38 37 End If 39 38 End Function … … 92 91 If Object.ReferenceEquals(sysDir, Nothing) Then 93 92 Dim size = GetSystemDirectory(0, 0) 94 Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR93 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR 95 94 Dim len = GetSystemDirectory(p, size) 96 95 sysDir = New String(p, len As Long) 97 _System_free(p)98 96 End If 99 97 Return sysDir … … 145 143 Dim src = ToTCStr(s) 146 144 Dim size = ExpandEnvironmentStrings(src, 0, 0) 147 Dim dst = _System_malloc(SizeOf (TCHAR) * size) As PTSTR145 Dim dst = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR 148 146 ExpandEnvironmentStrings(src, dst, size) 149 147 ExpandEnvironmentVariables = New String(dst, size - 1) 150 _System_free(dst)151 148 End Function 152 149 … … 160 157 Dim tcsVariable = ToTCStr(variable) 161 158 Dim size = _System_GetEnvironmentVariable(tcsVariable, 0, 0) 162 Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR159 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR 163 160 Dim len = _System_GetEnvironmentVariable(tcsVariable, p, size) 164 161 GetEnvironmentVariable = New String(p, len As Long) 165 _System_free(p)166 162 End Function 167 163 -
trunk/Include/Classes/System/IO/FileStream.ab
r349 r388 1 1 Namespace System 2 2 Namespace IO 3 4 3 5 4 /* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */ … … 28 27 fileShare As DWord 29 28 fileOptions As DWord 30 fileReadOverlapped As OVERLAPPED31 fileWriteOverlapped As OVERLAPPED29 30 offset As QWord 'オーバーラップドIO用 32 31 33 32 Public … … 108 107 This.fileShare = sh 109 108 This.fileOptions = op 109 This.offset = 0 110 110 End Sub 111 111 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare) … … 133 133 This.FileStream(path,mode,access,FileShare.None,FileOptions.None) 134 134 End Sub 135 136 Sub ~FileStream()137 This.Flush()138 This.Close()139 End Sub140 141 135 Public 142 136 Override Function CanRead() As Boolean … … 176 170 Function IsAsync() As Boolean 177 171 /* ファイルが非同期操作に対応しているかを返す */ 178 If This.fileOptions =FILE_FLAG_OVERLAPPED/*FileOptions.Asynchronous*/ Then172 If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then 179 173 Return True 180 174 Else … … 187 181 Dim length As LARGE_INTEGER 188 182 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 190 184 End If 191 185 End Function 192 186 193 187 Function Name() As String 194 Return New String(This.filePath)188 Return This.filePath 195 189 End Function 196 190 … … 198 192 If This.CanSeek() Then 199 193 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 204 195 Else 205 196 Dim position As LARGE_INTEGER … … 213 204 If This.CanSeek() Then 214 205 If This.IsAsync() Then 215 Return MAKEQWORD(fileReadOverlapped.Offset,fileReadOverlapped.OffsetHigh)206 Return offset As Int64 216 207 Else 217 208 Dim position As LARGE_INTEGER 218 209 ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER)) 219 210 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 221 212 End If 222 213 End If … … 257 248 End Function 258 249 259 Override Sub Close()260 This.Dispose()261 End Sub262 263 250 /* CreateObjRef*/ 264 251 265 Override Sub Dispose() 252 Override Sub Dispose(disposing As Boolean) 253 Flush() 266 254 CloseHandle(InterlockedExchangePointer(VarPtr(This.handle),NULL)) 267 255 End Sub 268 256 269 Override Function EndRead( ByRefasyncResult As System.IAsyncResult) As Long270 'TODO 271 End Function 272 273 Override Sub EndWrite( ByRefasyncResult 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) 274 262 'TODO 275 263 End Sub … … 298 286 299 287 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)) 300 295 End Sub 301 296 302 297 Override Function Read( buffer As *Byte, offset As Long, count As Long) As Long 303 298 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 318 314 End If 319 315 End Function … … 326 322 Select Case origin 327 323 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 332 325 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 337 327 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 342 329 End Select 343 330 Else … … 379 366 380 367 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 382 377 383 378 Override Sub Write(buffer As *Byte, offset As Long, count As Long) 384 379 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) 396 393 End If 397 394 End If -
trunk/Include/Classes/System/IO/Path.ab
r296 r388 10 10 Class Path 11 11 Public 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 ': 16 16 17 17 Static Function GetFileName(path As String) As String … … 121 121 122 122 Static Function Combine(path1 As String, path2 As String) As String 123 If path1.LastIndexOf( Chr$(VolumeSeparatorChar)) And path1.Length = 2 Then123 If path1.LastIndexOf(VolumeSeparatorChar) And path1.Length = 2 Then 124 124 Return path1 + path2 125 125 End If 126 126 127 If path1.LastIndexOf( Chr$(DirectorySeparatorChar), ELM(path1.Length), 1) = -1 Then127 If path1.LastIndexOf(DirectorySeparatorChar, ELM(path1.Length), 1) = -1 Then 128 128 Return path1 + Chr$(DirectorySeparatorChar) + path2 129 129 Else … … 133 133 134 134 Private 135 Static Function getExtensionPosition( ByRefpath As String) As Long135 Static Function getExtensionPosition(path As String) As Long 136 136 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) 138 141 End Function 139 142 140 Static Function getLastSeparatorPosision( ByRefpath As String) As Long141 Dim lastSepPos = path.LastIndexOf( Chr$(DirectorySeparatorChar)) As Long143 Static Function getLastSeparatorPosision(path As String) As Long 144 Dim lastSepPos = path.LastIndexOf(DirectorySeparatorChar) As Long 142 145 If lastSepPos <> -1 Then Return lastSepPos 143 146 144 lastSepPos = path.LastIndexOf( Chr$(VolumeSeparatorChar))147 lastSepPos = path.LastIndexOf(VolumeSeparatorChar) 145 148 Return lastSepPos 146 149 End Function -
trunk/Include/Classes/System/IO/Stream.ab
r381 r388 10 10 Public 11 11 Virtual Sub ~Stream() 12 This. Close()12 This.Dispose(False) 13 13 End Sub 14 14 Public … … 49 49 End Function 50 50 Virtual Sub Close() 51 This.Dispose()51 Dispose(True) 52 52 End Sub 53 Virtual Sub Dispose() 54 Dispose(True) 55 End Sub 56 Virtual Sub Dispose(disposing As Boolean): End Sub 53 57 Virtual Function EndRead(ByRef asyncResult As System.IAsyncResult) As Long: End Function 54 58 Virtual Sub EndWrite(ByRef asyncResult As System.IAsyncResult): End Sub -
trunk/Include/Classes/System/Runtime/InteropServices/GCHandle.ab
r340 r388 36 36 37 37 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 38 41 FromIntPtr = New GCHandle 39 42 FromIntPtr.handle = ip As VoidPtr -
trunk/Include/Classes/System/String.ab
r383 r388 61 61 Sub String(initStr As PCWSTR, start As Long, length As Long) 62 62 If start < 0 Or length Or start + length < 0 Then 63 'Throw New ArgumentOutOfRangeException63 Throw New ArgumentOutOfRangeException("String constractor: One or more arguments are out of range value.", "start or length or both") 64 64 End If 65 65 validPointerCheck(initStr + start, length) … … 78 78 79 79 Sub String(initStr As PCSTR, start As Long, length As Long) 80 If start < 0 Or length Or start + length< 0 Then81 'Throw New ArgumentOutOfRangeException80 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") 82 82 End If 83 83 validPointerCheck(initStr + start, length) … … 97 97 End Sub 98 98 99 Sub String(sb As System.Text.StringBuilder)99 Sub String(sb As Text.StringBuilder) 100 100 Chars = StrPtr(sb) 101 101 m_Length = sb.Length … … 246 246 247 247 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 252 251 Return CompareTo(y As String) 253 252 End Function … … 348 347 Const Function Contains(s As String) As Boolean 349 348 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 353 355 End Function 354 356 … … 385 387 rangeCheck(startIndex, count) 386 388 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") 389 390 End If 390 391 … … 405 406 End Function 406 407 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 407 438 Const Function LastIndexOf(s As String) As Long 408 439 Return LastIndexOf(s, m_Length - 1, m_Length) … … 413 444 End Function 414 445 415 Const Function LastIndexOf(s As String, start IndexAs Long, count As Long) As Long446 Const Function LastIndexOf(s As String, start As Long, count As Long) As Long 416 447 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 427 456 If length > m_Length Then Return -1 428 If length = 0 Then Return start Index457 If length = 0 Then Return start 429 458 430 459 Dim i As Long, j As Long 431 For i = start Index To startIndex- count + 1 Step -1460 For i = start To start - count + 1 Step -1 432 461 For j = length - 1 To 0 Step -1 433 462 If Chars[i + j] = s[j] Then … … 450 479 451 480 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) 453 482 sb.Insert(startIndex, text) 454 483 Return sb.ToString … … 471 500 472 501 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) 474 503 sb.Remove(startIndex, count) 475 504 Remove = sb.ToString … … 486 515 487 516 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) 489 518 sb.Replace(oldChar, newChar) 490 519 Replace = sb.ToString … … 492 521 493 522 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) 495 524 sb.Replace(oldStr, newStr) 496 525 Return sb.ToString … … 498 527 499 528 Const Function ToLower() As String 500 Dim sb = New System.Text.StringBuilder(m_Length)529 Dim sb = New Text.StringBuilder(m_Length) 501 530 sb.Length = m_Length 502 531 Dim i As Long 503 532 For i = 0 To ELM(m_Length) 504 sb[i] = _System_ASCII_ToLower(Chars[i])533 sb[i] = ActiveBasic.CType.ToLower(Chars[i]) 505 534 Next 506 535 Return sb.ToString … … 508 537 509 538 Const Function ToUpper() As String 510 Dim sb = New System.Text.StringBuilder(m_Length)539 Dim sb = New Text.StringBuilder(m_Length) 511 540 sb.Length = m_Length 512 541 Dim i As Long 513 542 For i = 0 To ELM(m_Length) 514 sb[i] = _System_ASCII_ToUpper(Chars[i])543 sb[i] = ActiveBasic.CType.ToUpper(Chars[i]) 515 544 Next 516 545 Return sb.ToString … … 539 568 Dim size = m_Length 540 569 #endif 541 Return _System_GetHashFromWordArray(Chars As *Word, size) Xor size570 Return _System_GetHashFromWordArray(Chars As *Word, size) Xor m_Length 542 571 End Function 543 572 … … 548 577 Function PadLeft(total As Long, c As StrChar) As String 549 578 If total < 0 Then 550 'Throw New ArgumentException579 Throw New ArgumentOutOfRangeException("String.PadLeft: An arguments is out of range value.", "total") 551 580 End If 552 581 If total >= m_Length Then 553 582 Return This 554 583 End If 555 Dim sb = New System.Text.StringBuilder(total)584 Dim sb = New Text.StringBuilder(total) 556 585 sb.Append(c, total - m_Length) 557 586 sb.Append(This) … … 565 594 Function PadRight(total As Long, c As StrChar) As String 566 595 If total < 0 Then 567 'Throw New ArgumentException596 Throw New ArgumentOutOfRangeException("String.PadRight: An arguments is out of range value.", "total") 568 597 End If 569 598 If total >= m_Length Then 570 599 Return This 571 600 End If 572 Dim sb = New System.Text.StringBuilder(total)601 Dim sb = New Text.StringBuilder(total) 573 602 sb.Append(This) 574 603 sb.Append(c, total - m_Length) … … 596 625 Const Sub rangeCheck(index As Long) 597 626 If index < 0 Or index > m_Length Then 598 Debug 'ArgumentOutOfRangeException627 Throw New ArgumentOutOfRangeException("String: An arguments is out of range value.", "index") 599 628 End If 600 629 End Sub … … 602 631 Const Sub rangeCheck(start As Long, length As Long) 603 632 If start < 0 Or start > This.m_Length Or length < 0 Then 604 Debug 'ArgumentOutOfRangeException633 Throw New ArgumentOutOfRangeException("String: One or more arguments are out of range value.", "start or length or both") 605 634 End If 606 635 End Sub -
trunk/Include/Classes/System/Text/StringBuilder.ab
r385 r388 128 128 Return This 129 129 Else 130 Throw New ArgumentNullException("StringBuilder.Append: An argument was null", "s")130 Throw New ArgumentNullException("StringBuilder.Append: An argument is null", "s") 131 131 End If 132 132 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") 134 134 End If 135 135 appendCore(s, startIndex, count) … … 169 169 Const Sub CopyTo(sourceIndex As Long, ByRef dest[] As StrChar, destIndex As Long, count As Long) 170 170 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") 172 172 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") 174 174 End If 175 175 … … 179 179 Function EnsureCapacity(c As Long) As Long 180 180 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") 182 182 ElseIf c > Capacity Then 183 183 Dim p = GC_malloc_atomic((c + 1) * SizeOf (StrChar)) As *StrChar … … 291 291 rangeCheck(index) 292 292 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") 294 294 End If 295 295 Dim len = x.Length … … 310 310 rangeCheck(i) 311 311 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") 313 313 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") 315 315 End If 316 316 … … 381 381 Sub replaceCore(oldStr As String, newStr As String, start As Long, count As Long) 382 382 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") 384 384 ElseIf oldStr.Length = 0 Then 385 385 Throw New ArgumentException("StringBuilder.Replace: The argument 'oldStr' is empty string. ", "oldStr") … … 428 428 Sub Capacity(c As Long) 429 429 If c < size Or c > MaxCapacity Then 'sizeとの比較でcが負の場合も対応 430 Throw New ArgumentOutOfRangeException("StringBuilder. Append: An argument haveout of range value.", "c")430 Throw New ArgumentOutOfRangeException("StringBuilder.Capacity: An argument is out of range value.", "c") 431 431 End If 432 432 EnsureCapacity(c) … … 435 435 Const Function Chars(i As Long) As StrChar 436 436 If i >= Length Or i < 0 Then 437 Throw New IndexOutOfRangeException("StringBuilder.Chars: The index argument 'i' haveout of range value.")437 Throw New IndexOutOfRangeException("StringBuilder.Chars: The index argument 'i' is out of range value.") 438 438 End If 439 439 Return chars[i] … … 442 442 Sub Chars(i As Long, c As StrChar) 443 443 If i >= Length Or i < 0 Then 444 Throw New ArgumentOutOfRangeException("StringBuilder.Chars: An argument haveout of range value.", "i")444 Throw New ArgumentOutOfRangeException("StringBuilder.Chars: An argument is out of range value.", "i") 445 445 End If 446 446 chars[i] = c … … 474 474 Sub initialize(capacity As Long, maxCapacity = LONG_MAX As Long) 475 475 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") 477 477 End If 478 478 … … 506 506 Sub rangeCheck(index As Long) 507 507 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.") 509 509 End If 510 510 End Sub … … 517 517 'length < 0は判定に入っていないことに注意 518 518 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") 520 520 End If 521 521 End Sub -
trunk/Include/Classes/System/Threading/WaitHandle.ab
r381 r388 38 38 End Sub 39 39 40 OverrideSub Dispose()40 Virtual Sub Dispose() 41 41 Dim hDisposing = InterlockedExchangePointer(h, 0) 42 42 If hDisposing <> 0 Then … … 49 49 End Function 50 50 51 Function WaitOne(millisecondsTimeout As Long, exitContext As B OOL) As Boolean51 Function WaitOne(millisecondsTimeout As Long, exitContext As Boolean) As Boolean 52 52 Return WaitHandle.AfterWait(WaitForSingleObject(h, millisecondsTimeout As DWord), 1) 53 53 End Function … … 80 80 81 81 Public 82 Static Function SignalAndWait(toSignal As WaitHandle, toWaitOn As WaitHandle, millisecondsTimeout As Long, exitContext As B OOL) As Boolean82 Static Function SignalAndWait(toSignal As WaitHandle, toWaitOn As WaitHandle, millisecondsTimeout As Long, exitContext As Boolean) As Boolean 83 83 Dim pSignalObjectAndWait = GetProcAddress(GetModuleHandle("Kernel32.dll"), "SignalObjectAndWait") As Detail.PFNSignalObjectAndWait 84 84 If pSignalObjectAndWait = 0 Then 85 ' PlatformNotSupportedException 86 Debug 87 ExitThread(-1) 85 Throw New PlatformNotSupportedException("WaitHandle.SignalAndWait: This platform doesn't supoort this operation.") 88 86 End If 89 87 Return WaitHandle.AfterWait(pSignalObjectAndWait(toSignal.Handle, toWaitOn.Handle, millisecondsTimeout As DWord, FALSE), 1) -
trunk/Include/Classes/System/Windows/Forms/Application.ab
r319 r388 27 27 Return System.IO.Path.GetDirectoryName( ExecutablePath ) 28 28 End Function 29 30 Static Sub ExitThread() 31 PostQuitMessage(0) 32 End Sub 29 33 End Class 30 31 34 32 35 End Namespace -
trunk/Include/Classes/System/Windows/Forms/Control.ab
r381 r388 4 4 #define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__ 5 5 6 /* 6 7 #require <Classes/System/Windows/Forms/misc.ab> 7 8 #require <Classes/System/Windows/Forms/CreateParams.ab> … … 11 12 #require <Classes/System/Math.ab> 12 13 #require <Classes/System/Threading/WaitHandle.ab> 14 */ 13 15 #require <Classes/System/Drawing/Color.ab> 14 16 #require <Classes/System/Drawing/Point.ab> 15 17 #require <Classes/System/Drawing/Size.ab> 16 18 #require <Classes/System/Drawing/Rectangle.ab> 19 /* 17 20 #require <Classes/System/Runtime/InteropServices/GCHandle.ab> 18 21 #require <Classes/ActiveBasic/Windows/WindowHandle.sbp> 19 22 #require <Classes/ActiveBasic/Strings/Strings.ab> 20 23 */ 21 24 Namespace System 22 25 Namespace Windows … … 143 146 End If 144 147 End Function 145 148 /* BoundsSpecifiedが使用不能なのでコメントアウト 146 149 Sub Bounds(r As Rectangle) 147 150 SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All) 148 151 End Sub 149 152 */ 150 153 Const Function Location() As Point 151 154 Return Bounds.Location 152 155 End Function 153 156 /* 154 157 Sub Location(p As Point) 155 158 SetBoundsCore(p.X, p.Y, 0, 0, BoundsSpecified.Location) 156 159 End Sub 157 160 */ 158 161 Const Function Size() As Size 159 162 Return Bounds.Size 160 163 End Function 161 164 /* 162 165 Sub Size(s As Size) 163 166 SetBoundsCore(0, 0, s.Width, s.Height, BoundsSpecified.Size) … … 171 174 Return ClientRectangle.Size 172 175 End Function 173 176 */ 174 177 Const Function Left() As Long 175 178 Dim b = Bounds 176 179 Return b.Left 177 180 End Function 178 181 /* 179 182 Sub Left(l As Long) 180 183 SetBoundsCore(l, 0, 0, 0, BoundsSpecified.X) 181 184 End Sub 182 185 */ 183 186 Const Function Top() As Long 184 187 Dim b = Bounds 185 188 Return b.Top 186 189 End Function 187 190 /* 188 191 Sub Top(t As Long) 189 192 SetBoundsCore(0, t, 0, 0, BoundsSpecified.Y) 190 193 End Sub 191 194 */ 192 195 Const Function Width() As Long 193 196 Dim b = Bounds 194 197 Return b.Width 195 198 End Function 196 199 /* 197 200 Sub Width(w As Long) 198 201 SetBoundsCore(0, 0, w, 0, BoundsSpecified.Width) 199 202 End Sub 200 203 */ 201 204 Const Function Height() As Long 202 205 Dim b = Bounds 203 206 Return b.Height 204 207 End Function 205 208 /* 206 209 Sub Height(h As Long) 207 210 SetBoundsCore(0, 0, 0, h, BoundsSpecified.Height) 208 211 End Sub 209 212 */ 210 213 Const Function Right() As Long 211 214 Dim b = Bounds … … 273 276 274 277 Sub Control() 275 Debug276 278 Dim sz = DefaultSize() 277 Control("", 100, 100, sz.Width, sz.Height)279 init(Nothing, "", 100, 100, sz.Width, sz.Height) 278 280 End Sub 279 281 280 282 Sub Control(text As String) 281 283 Dim sz = DefaultSize() 282 Control(text, 100, 100, sz.Width, sz.Height)284 init(Nothing, text, 100, 100, sz.Width, sz.Height) 283 285 End Sub 284 286 285 287 Sub Control(parent As Control, text As String) 286 288 Dim sz = DefaultSize() 287 Control(parent, text, 100, 100, sz.Width, sz.Height)289 init(parent, text, 100, 100, sz.Width, sz.Height) 288 290 End Sub 289 291 290 292 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) 293 294 End Sub 294 295 295 296 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 300 Private 301 302 Sub init(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long) 296 303 This.parent = parent 297 Control(text, left, top, width, height) 298 End Sub 304 ' CreateControl() 305 End Sub 306 299 307 300 308 '--------------------------------------------------------------------------- 301 309 ' Destractor 302 310 Public 303 311 Virtual Sub ~Control() 304 312 If Not Object.ReferenceEquals(wnd, Nothing) Then … … 398 406 399 407 Virtual Function DefaultSize() As Size 400 Dim s As Size(300, 300) 401 Return s 408 Return New Size(300, 300) 402 409 End Function 403 410 … … 411 418 ' Protected Methods 412 419 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 413 427 Dim createParams = CreateParams() 414 428 Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(This) 415 429 TlsSetValue(tlsIndex, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch) As VoidPtr) 416 430 With createParams 417 Dim hwndParent = 0 As HWND418 If Not Object.ReferenceEquals(parent, Nothing) Then419 hwndParent = parent.Handle420 End If421 431 Dim pText As PCTSTR 422 432 If String.IsNullOrEmpty(text) Then … … 427 437 428 438 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 Then439 .X, .Y, .Width, .Height, _ 440 .Parent, 0, hInstance, 0) = 0 Then 431 441 ' Error 432 442 Dim buf[1023] As TCHAR 433 443 wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError()) 434 444 OutputDebugString(buf) 445 446 gch.Free() 435 447 ' Debug 436 448 ExitThread(0) 437 449 End If 438 450 End With 439 gch.Free()451 440 452 End Sub 441 453 … … 475 487 Case WM_DESTROY 476 488 OnHandleDestroyed(System.EventArgs.Empty) 489 490 Case WM_LBUTTONDOWN 491 Goto *ButtonDown 492 *ButtonDown 477 493 Case Else 478 494 DefWndProc(m) … … 521 537 End Sub 522 538 523 Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub539 ' Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub 524 540 Virtual Sub OnEnabledChanged(e As System.EventArgs) : End Sub 525 541 Virtual Sub OnBackColorChanged(e As System.EventArgs) : End Sub … … 582 598 .Style = WS_OVERLAPPEDWINDOW 583 599 .ExStyle = WS_EX_APPWINDOW 600 .Caption = String.Empty 601 .X = 0 602 .Y = 0 603 .Width = 0 604 .Height = 0 584 605 End With 585 606 End Sub … … 608 629 rThis.wnd = New ActiveBasic.Windows.WindowHandle(hwnd) 609 630 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() 610 634 End If 611 635 -
trunk/Include/Classes/System/Windows/Forms/Message.ab
r303 r388 4 4 #define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ 5 5 6 #require <windows.sbp>6 '#require <windows.sbp> 7 7 8 8 Namespace System … … 65 65 End Function 66 66 67 Const Function Operator ==(x As Message) As B OOL67 Const Function Operator ==(x As Message) As Boolean 68 68 Return Equals(x) 69 69 End Function 70 70 71 Const Function Operator <>(x As Message) As B OOL71 Const Function Operator <>(x As Message) As Boolean 72 72 Return Not Equals(x) 73 73 End Function -
trunk/Include/Classes/System/Windows/Forms/MessageBox.ab
r319 r388 1 1 'Classes/System/Windows/Forms/MessageBox.ab 2 2 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> 5 5 6 6 Namespace System -
trunk/Include/Classes/System/Windows/Forms/PaintEventArgs.ab
r282 r388 3 3 #ifndef __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ 4 4 #define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ 5 6 #require <Classes/System/misc.ab>7 5 8 6 Namespace System -
trunk/Include/Classes/System/Windows/Forms/misc.ab
r303 r388 9 9 10 10 Interface IWin32Window 11 /*Const*/Function Handle() As HWND11 Function Handle() As HWND 12 12 End Interface 13 13 14 TypeDef BoundsSpecified = Long 15 /* 14 16 Enum BoundsSpecified 15 17 None = &h0 … … 22 24 All = BoundsSpecified.Location Or BoundsSpecified.Size 23 25 End Enum 24 26 */ 27 28 /* 25 29 Enum Keys 26 30 LButton = VK_LBUTTON … … 208 212 End Enum 209 213 214 Enum MouseButtons 215 None = 0 216 Left = &h00100000 217 Right = &h00200000 218 Middle = &h00400000 219 XButton1 = &h00800000 220 XButton2 = &h01000000 221 End Enum 222 */ 223 224 TypeDef DialogResult = DWord 225 TypeDef MouseButtons = DWord 226 227 Class MouseEventArgs 228 Inherits System.EventArgs 229 Public 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 244 End Class 245 210 246 End Namespace 'Forms 211 247 End Namespace 'Widnows -
trunk/Include/Classes/index.ab
r385 r388 2 2 #require "./ActiveBasic/Core/InterfaceInfo.ab" 3 3 #require "./ActiveBasic/Core/TypeInfo.ab" 4 #require "./ActiveBasic/CType/CType.ab" 4 5 #require "./ActiveBasic/Math/Math.ab" 5 6 #require "./ActiveBasic/Strings/SPrintF.ab" -
trunk/Include/api_system.sbp
r369 r388 567 567 Declare Function GetOverlappedResult Lib "kernel32" ( 568 568 hFile As HANDLE, 569 pOverlapped As *OVERLAPPED,570 pNumberOfBytesTransferred AS *DWord,569 ByRef Overlapped As OVERLAPPED, 570 ByRef pNumberOfBytesTransferred As DWord, 571 571 bWait As BOOL 572 572 ) As BOOL … … 769 769 NumberOfArguments As DWord, 770 770 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 BOOL771 Declare Function ReadFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToRead As DWord, lpNumberOfBytesRead As *DWord, ByRef Overlapped As OVERLAPPED) As BOOL 772 772 Declare Function ReadProcessMemory Lib "Kernel32" (hProcess As HANDLE, lpBaseAddress As VoidPtr, lpBuffer As VoidPtr, nSize As SIZE_T, lpNumberOfBytesRead As *SIZE_T) As BOOL 773 773 Declare Function ReleaseMutex Lib "kernel32" (hMutex As HANDLE) As BOOL … … 874 874 ) As Long 875 875 876 Declare Function WriteFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToWrite As DWord, lpNumberOfBytesWritten As DWordPtr, ByRef lpOverlapped As OVERLAPPED) As BOOL876 Declare Function WriteFile Lib "kernel32" (hFile As HANDLE, lpBuffer As VoidPtr, nNumberOfBytesToWrite As DWord, lpNumberOfBytesWritten As *DWord, ByRef pOverlapped As OVERLAPPED) As BOOL 877 877 Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As VoidPtr, dwLength As DWord) 878 878 -
trunk/Include/basic/function.sbp
r385 r388 78 78 79 79 Function 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)) 82 85 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 95 91 End Function 96 92 … … 272 268 Return New String(c As StrChar, 1) 273 269 ElseIf c < &h10FFFF Then 274 Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As StrChar270 Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As WCHAR 275 271 Return New String(t, 2) 276 272 Else … … 306 302 End Function 307 303 308 Dim _System_HexadecimalTable[&h10] = [&h30, &h31, &h32, &h33, &h34, &h35, &h36, &h37, &h38, &h39, &h41, &h42, &h43, &h44, &h45, &h46] As Byte309 310 Function _System_Hex(x As DWord, zeroSuppress As Boolean) As String311 Dim s[7] As StrChar312 Dim i As Long313 For i = 0 To ELM(Len (s) \ SizeOf (StrChar))314 s[i] = _System_HexadecimalTable[x >> 28] As StrChar315 x <<= 4316 Next317 If zeroSuppress Then318 Dim i As Long319 For i = 0 To 6320 If s[i] <> &h30 Then 'Asc("0")321 Exit For322 End If323 Next324 Return New String(VarPtr(s[i]) As *StrChar, Len (s) \ SizeOf (StrChar) - i)325 Else326 Return New String(s As *StrChar, Len (s) \ SizeOf (StrChar))327 End If328 End Function329 330 304 Function Hex$(x As DWord) As String 331 Hex$ = _System_Hex(x, True) 305 Imports ActiveBasic.Strings.Detail 306 Hex$ = FormatIntegerX(x, 1, 0, None) 332 307 End Function 333 308 334 309 Function 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) 340 312 End Function 341 313 … … 391 363 End Function 392 364 393 Const _System_MaxFigure_Oct_QW = 22 As DWord 'QWORD_MAX = &o1,777,777,777,777,777,777,777394 365 Function 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) 368 End Function 369 408 370 Function 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) 419 373 End Function 420 374 … … 493 447 494 448 Function 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 496 452 Return "NaN" 497 ElseIf ActiveBasic.Math.IsInf(dbl) Then453 ElseIf IsInf(dbl) Then 498 454 If dbl > 0 Then 499 455 Return "Infinity" … … 521 477 buffer[i] = Asc(".") 522 478 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) 524 480 i += 14 525 481 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)) 527 483 End If 528 484 … … 637 593 If String.IsNullOrEmpty(s) Then 638 594 Return New String(0 As StrChar, n) 639 595 Else 640 596 Return New String(s[0], n) 641 597 End If … … 971 927 972 928 /*! 973 @brief ABオブジェクトを指すポインタをObject型へ変換。929 @brief ObjPtrの逆。ABオブジェクトを指すポインタをObject型へ変換。 974 930 @author Egtra 975 931 @date 2007/08/24 … … 1012 968 End Function 1013 969 1014 Function _System_ASCII_IsUpper(c As WCHAR) As Boolean1015 Return c As DWord - &h41 < 26 ' &h41 = Asc("A")1016 End Function1017 1018 Function _System_ASCII_IsUpper(c As SByte) As Boolean1019 Return _System_ASCII_IsUpper(c As Byte As WCHAR)1020 End Function1021 1022 Function _System_ASCII_IsLower(c As WCHAR) As Boolean1023 Return c As DWord - &h61 < 26 ' &h61 = Asc("a")1024 End Function1025 1026 Function _System_ASCII_IsLower(c As SByte) As Boolean1027 Return _System_ASCII_IsLower(c As Byte As WCHAR)1028 End Function1029 1030 Function _System_ASCII_ToLower(c As WCHAR) As WCHAR1031 If _System_ASCII_IsUpper(c) Then1032 Return c Or &h201033 Else1034 Return c1035 End If1036 End Function1037 1038 Function _System_ASCII_ToLower(c As SByte) As SByte1039 Return _System_ASCII_ToLower(c As Byte As WCHAR) As Byte As SByte1040 End Function1041 1042 Function _System_ASCII_ToUpper(c As WCHAR) As WCHAR1043 If _System_ASCII_IsLower(c) Then1044 Return c And (Not &h20)1045 Else1046 Return c1047 End If1048 End Function1049 1050 Function _System_ASCII_ToUpper(c As SByte) As SByte1051 Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte1052 End Function1053 1054 970 Function _System_GetHashFromWordArray(p As *Word, n As SIZE_T) As Long 1055 971 Dim hash = 0 As DWord -
trunk/Include/system/debug.sbp
r259 r388 29 29 End Function 30 30 31 Sub _DebugSys_Set_LONG_PTR(pPtr As VoidPtr, lpData As LONG_PTR)32 #ifdef _WIN6433 SetQWord(pPtr,lpData)34 #else35 SetDWord(pPtr,lpData)36 #endif37 End Sub38 39 31 Sub _DebugSys_StartProc(lpSpBase As ULONG_PTR, lpObp As ULONG_PTR) 40 32 Dim i As Long … … 53 45 _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2) 54 46 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) 57 49 58 50 _DebugSys_ProcNum[ThreadNum]=_DebugSys_ProcNum[ThreadNum]+1 … … 77 69 _DebugSys_lplpSpBase[ThreadNum]=HeapAlloc(GetProcessHeap(),0,SizeOf(ULONG_PTR)*2) 78 70 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) 81 73 End Sub 82 74 -
trunk/Include/system/exception.ab
r375 r388 57 57 End If 58 58 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 60 61 ' マッチしたとき 61 62 Return codePos … … 64 65 Wend 65 66 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 66 79 End Function 67 80 End Class … … 114 127 115 128 'TODO: 適切なエラー処理 116 MessageBox( NULL, " 例外", "", MB_OK or MB_ICONEXCLAMATION )117 129 MessageBox( NULL, "Catchされていない例外があります", NULL, MB_OK or MB_ICONEXCLAMATION ) 130 Debug 118 131 Return 119 132 End If -
trunk/TestCase/SimpleTestCase/ExceptionTest.ab
r385 r388 2 2 3 3 Sub BadProc() 4 Throw New System. Exception("hello! I am bad proc.")4 Throw New System.SystemException("hello! I am bad proc.") 5 5 End Sub 6 6 -
trunk/TestCase/SimpleTestCase/PathTest.ab
r299 r388 9 9 Sub TestMain() 10 10 Dim testPath = New String("C:\Dir.Name\file.name.ext") 11 12 11 UnitTest("Path.GetFileName", Path.GetFileName(testPath) = "file.name.ext") 13 12 … … 40 39 41 40 End Namespace 42 41 Try 43 42 PathTest.TestMain() 43 Catch e As System.Exception 44 Debug 45 Print e.ToString() 46 End Try
Note:
See TracChangeset
for help on using the changeset viewer.