Changeset 383 for trunk/Include
- Timestamp:
- Nov 17, 2007, 9:34:36 AM (17 years ago)
- Location:
- trunk/Include
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab
r365 r383 102 102 Cap = &h20 103 103 104 '!BASIC接頭辞。&h, &oなど。 105 BPrefix = &h40 106 104 107 /*! 105 108 内部処理用に予約。 … … 114 117 @date 2007/09/18 115 118 @param[in] x 文字列化する浮動小数点数値。 116 @param[in] d精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。119 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。 117 120 @param[in] field フィールド幅。 118 121 @param[in] flags 書式フラグ。 … … 121 124 @todo 他の実装での末尾桁の扱いを調べる(このコードでは何もしていないので切捨となっている)。 122 125 */ 123 Function FormatFloatE(x As Double, dAs DWord, field As DWord, flags As FormatFlags) As String124 If d= DWORD_MAX Then125 d= 6126 Function FormatFloatE(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String 127 If precision = DWORD_MAX Then 128 precision = 6 126 129 End If 127 130 128 131 Dim e As Long, negative As Boolean 129 132 Dim s = FloatToChars(x, e, negative) 130 131 Dim sb = New System.Text.StringBuilder 132 With sb 133 134 AppendSign(sb, negative, flags) 133 Dim sb = FormatFloatE_Base(s, negative, precision, flags) 134 FormatFloatE_Exponent(sb, e, flags) 135 AdjustFieldWidth(sb, field, flags) 136 FormatFloatE = sb.ToString() 137 End Function 138 139 /** 140 @brief FormatFloatEの符号・基数部の出力用。 141 @author Egtra 142 @date 2007/10/27 143 */ 144 Function FormatFloatE_Base(s As String, negative As Boolean, precision As DWord, ByRef flags As FormatFlags) As System.Text.StringBuilder 145 FormatFloatE_Base = New System.Text.StringBuilder 146 With FormatFloatE_Base 147 AppendSign(FormatFloatE_Base, negative, flags) 135 148 136 149 .Append(s[0]) 137 150 138 If (flags And Alt) Or d> 0 Then151 If (flags And Alt) Or precision > 0 Then 139 152 .Append(".") 140 153 Dim outputLen = s.Length - 1 141 If outputLen >= dThen142 .Append(s, 1, d)154 If outputLen >= precision Then 155 .Append(s, 1, precision) 143 156 Else 'sで用意された桁が指定された精度より少ないとき 144 157 .Append(s, 1, outputLen) 145 .Append(&h30 As StrChar, d- outputLen) '足りない桁は0埋め158 .Append(&h30 As StrChar, precision - outputLen) '足りない桁は0埋め 146 159 End If 147 160 End If 148 161 End With 162 End Function 163 164 /** 165 @brief FormatFloatEの指数部の出力用。 166 @author Egtra 167 @date 2007/10/27 168 */ 169 Sub FormatFloatE_Exponent(buf As System.Text.StringBuilder, e As Long, flags As FormatFlags) 170 With buf 149 171 If flags And Cap Then 150 172 .Append("E") … … 152 174 .Append("e") 153 175 End If 154 155 176 .Append(FormatIntegerD(e, 2, 0, Sign Or Zero)) 156 157 AdjustFieldWidth(sb, field, flags)158 177 End With 159 FormatFloatE = sb.ToString() 160 End Function 178 End Sub 161 179 162 180 /*! … … 177 195 Dim e As Long, negative As Boolean 178 196 Dim s = FloatToChars(x, e, negative) 179 180 Dim sb = New System.Text.StringBuilder 181 With sb 182 AppendSign(sb, negative, flags) 197 Dim sb = FormatFloatF_Core(s, e, negative, precision, flags) 198 AdjustFieldWidth(sb, field, flags) 199 FormatFloatF = sb.ToString() 200 End Function 201 202 /** 203 @author Egtra 204 @date 2007/10/27 205 */ 206 Function FormatFloatF_Core(s As String, e As Long, negative As Boolean, precision As DWord, ByRef flags As FormatFlags) As System.Text.StringBuilder 207 FormatFloatF_Core = New System.Text.StringBuilder 208 With FormatFloatF_Core 209 AppendSign(FormatFloatF_Core, negative, flags) 183 210 184 211 Dim intPartLen = e + 1 … … 215 242 End If 216 243 End If 217 AdjustFieldWidth(sb, field, flags)218 244 End With 219 FormatFloatF = sb.ToString() 245 End Function 246 247 /*! 248 @brief 浮動小数点数をprintfの%g, %G(小数・指数、十進法)相当の変換で文字列化する関数。 249 @author Egtra 250 @date 2007/10/23 251 @param[in] x 文字列化する浮動小数点数値。 252 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXまたは0のとき、指定なしとして既定値6となる。 253 @param[in] field フィールド幅。 254 @param[in] flags 書式フラグ。 255 @return xの文字列表現 256 @todo 下位桁の扱いの調査。 257 */ 258 Function FormatFloatG(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String 259 'GではE/Fと違い整数部も有効桁数に数えるのでその分を引いておく。 260 If precision = DWORD_MAX Or precision = 0 Then 261 precision = 5 262 Else 263 precision-- 264 End If 265 266 Dim e As Long, negative As Boolean 267 Dim s = FloatToChars(x, e, negative) 268 269 Dim sb = Nothing As System.Text.StringBuilder 270 271 If -5 < e And e < precision Then 272 sb = FormatFloatF_Core(s, e, negative, -e + precision, flags) 273 FormatFloatG_RemoveLowDigit(sb, flags) 274 Else 275 sb = FormatFloatE_Base(s, negative, precision, flags) 276 FormatFloatG_RemoveLowDigit(sb, flags) 277 FormatFloatE_Exponent(sb, e, flags) 278 End If 279 280 AdjustFieldWidth(sb, field, flags) 281 FormatFloatG = sb.ToString() 282 End Function 283 284 /*! 285 @brief FormatFloatG/A用の小数点以下末尾の0を削除するルーチン 286 @author Egtra 287 @date 2007/10/27 288 @param[in, out] sb 文字列バッファ 289 @param[in] flags フラグ 290 flagsでAltが立っているとき、この関数は何もしない。 291 */ 292 Sub FormatFloatG_RemoveLowDigit(sb As System.Text.StringBuilder, flags As FormatFlags) 293 Imports ActiveBasic.Strings 294 295 Dim count = sb.Length 296 If (flags And Alt) = 0 Then 297 Dim point = ChrFind(StrPtr(sb), count As SIZE_T, Asc(".")) 298 If point = -1 Then 299 Debug 300 End If 301 302 Dim i As Long 303 For i = count - 1 To point + 1 Step -1 304 If sb[i] <> &h30 Then 305 Exit For 306 End If 307 Next 308 If i <> point Then 309 i++ 310 End If 311 sb.Length = i 312 End If 313 End Sub 314 315 /*! 316 @brief 浮動小数点数をprintfの%a, %A(指数形式、十六進法)相当の変換で文字列化する関数。 317 @author Egtra 318 @date 2007/09/18 319 @param[in] x 文字列化する浮動小数点数値。 320 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値13となる。 321 @param[in] field フィールド幅。 322 @param[in] flags 書式フラグ。 323 @return xの文字列表現 324 325 C99では、末尾の0を取り除いても良いとあるので、 326 このルーチンでは取り除くことにしている。 327 */ 328 Function FormatFloatA(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String 329 If precision = DWORD_MAX Then 330 precision = 13 331 End If 332 333 Dim pqw = VarPtr(x) As *QWord 334 335 Dim sb = New System.Text.StringBuilder 336 With sb 337 Dim sign = (GetQWord(pqw) And &H8000000000000000) As Boolean 338 pqw[0] And= &h7fffffffffffffff 339 340 AppendSign(sb, sign, flags) 341 342 If flags And BPrefix Then 343 .Append("&H") 344 Else 345 .Append("0X") 346 End If 347 348 Dim biasedExp = (GetQWord(pqw) >> 52) As DWord And &h7FF 349 Dim exp As Long 350 If biasedExp = 0 Then 351 If GetQWord(pqw) <> 0 Then 352 exp = -1022 '非正規化数への対応 353 Else 354 exp = 0 355 End If 356 .Append("0") 357 Else 358 exp = biasedExp - 1023 359 .Append("1") 360 End If 361 362 If precision > 0 Or (flags And Alt) Then 363 .Append(".") 364 Dim base = FormatIntegerLX(GetQWord(pqw) And &h000fffffffffffff, 13, 0, flags And Cap) 365 Dim diff = precision - 13 As Long 366 If diff <= 0 Then 367 .Append(Left$(base, precision)) 368 Else 369 .Append(base).Append(&h30, diff) 370 End If 371 End If 372 373 FormatFloatG_RemoveLowDigit(sb, flags) 374 375 .Append("P") 376 .Append(FormatIntegerD(exp, 1, 0, Sign)) 377 378 FormatFloatA = .ToString() 379 End With 380 381 If (flags And Cap) = 0 Then 382 FormatFloatA = FormatFloatA.ToLower() 383 End If 220 384 End Function 221 385 … … 261 425 */ 262 426 Function FormatIntegerU(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String 263 Return FormatIntegerEx(TraitsInteger DU, x, d, field, flags And (Not (Sign Or Blank)))427 Return FormatIntegerEx(TraitsIntegerU[0], x, d, field, flags And (Not (Sign Or Blank))) 264 428 End Function 265 429 … … 270 434 */ 271 435 Function FormatIntegerLU(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String 272 Return FormatIntegerEx(TraitsInteger LDU, x, d, field, flags And (Not (Sign Or Blank)))436 Return FormatIntegerEx(TraitsIntegerU[1], x, d, field, flags And (Not (Sign Or Blank))) 273 437 End Function 274 438 … … 284 448 */ 285 449 Function FormatIntegerD(x As Long, d As DWord, field As DWord, flags As FormatFlags) As String 286 Dim unsignedX As DWord 287 If x < 0 Then 288 unsignedX = (-x) As DWord 289 flags Or= Minus 290 Else 291 unsignedX = x As DWord 292 End If 293 294 Return FormatIntegerEx(TraitsIntegerDU, unsignedX, d, field, flags) 450 Return FormatIntegerEx(TraitsIntegerD[0], (x As Int64) As QWord, d, field, flags) 295 451 End Function 296 452 … … 301 457 */ 302 458 Function FormatIntegerLD(x As Int64, d As DWord, field As DWord, flags As FormatFlags) As String 303 Dim unsignedX As QWord 304 If x < 0 Then 305 unsignedX = (-x) As QWord 306 flags Or= Minus 307 Else 308 unsignedX = x As QWord 309 End If 310 311 Return FormatIntegerEx(TraitsIntegerLDU, unsignedX, d, field, flags) 459 Return FormatIntegerEx(TraitsIntegerD[1], x As QWord, d, field, flags) 312 460 End Function 313 461 … … 316 464 @date 2007/10/26 317 465 */ 318 Dim TraitsInteger DUAs IntegerConvertTraits319 With TraitsInteger DU320 .Convert = AddressOf(Integer DU_Convert)321 .Prefix = AddressOf(Integer DU_Prefix)466 Dim TraitsIntegerU[1] As IntegerConvertTraits 467 With TraitsIntegerU[0] 468 .Convert = AddressOf(IntegerU_Convert) 469 .Prefix = AddressOf(IntegerU_Prefix) 322 470 .MaxSize = MaxSizeU 323 471 End With 324 472 325 /*! 326 @author Egtra 327 @date 2007/10/26 328 */ 329 Dim TraitsIntegerLDU As IntegerConvertTraits 330 With TraitsIntegerLDU 331 .Convert = AddressOf(IntegerLDU_Convert) 332 .Prefix = AddressOf(IntegerDU_Prefix) 473 With TraitsIntegerU[1] 474 .Convert = AddressOf(IntegerLU_Convert) 475 .Prefix = AddressOf(IntegerU_Prefix) 333 476 .MaxSize = MaxSizeLU 334 477 End With 335 478 336 479 /*! 480 @author Egtra 481 @date 2007/10/28 482 */ 483 Dim TraitsIntegerD[1] As IntegerConvertTraits 484 With TraitsIntegerD[0] 485 .Convert = AddressOf(IntegerD_Convert) 486 .Prefix = AddressOf(IntegerD_Prefix) 487 .MaxSize = MaxSizeU 488 End With 489 490 With TraitsIntegerD[1] 491 .Convert = AddressOf(IntegerLD_Convert) 492 .Prefix = AddressOf(IntegerD_Prefix) 493 .MaxSize = MaxSizeLU 494 End With 495 496 /*! 337 497 @brief 負数を表すフラグ。FormatIntegerD, LDからIntegerDU_Prefixまでの内部処理用。 338 498 @author Egtra … … 345 505 @date 2007/10/26 346 506 */ 347 Function Integer DU_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord507 Function IntegerU_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord 348 508 Dim x = xq As DWord 349 509 Dim i = MaxSizeU … … 357 517 358 518 /*! 359 @brief Integer DU_ConvertのQWord版519 @brief IntegerU_ConvertのQWord版 360 520 @author Egtra 361 521 @date 2007/10/26 362 522 @bug #117のため、現在Int64の最大値を超える値を正しく処理できない。 363 523 */ 364 Function IntegerL DU_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord524 Function IntegerLU_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord 365 525 Dim i = MaxSizeLU 366 526 While x <> 0 … … 376 536 @date 2007/10/26 377 537 */ 378 Function IntegerDU_Prefix(x As QWord, flags As FormatFlags) As String 379 If flags And Minus Then 380 IntegerDU_Prefix = "-" 538 Function IntegerU_Prefix(x As QWord, flags As FormatFlags) As String 539 End Function 540 541 /*! 542 @author Egtra 543 @date 2007/10/28 544 */ 545 Function IntegerD_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord 546 Return IntegerU_Convert(buf, Abs((xq As DWord) As Long) As DWord, flags) 547 End Function 548 549 /*! 550 @brief IntegerD_ConvertのInt64版 551 @author Egtra 552 @date 2007/10/28 553 */ 554 Function IntegerLD_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord 555 Return IntegerLU_Convert(buf, Abs(x As Int64) As QWord, flags) 556 End Function 557 558 /*! 559 @author Egtra 560 @date 2007/10/28 561 */ 562 Function IntegerD_Prefix(x As QWord, flags As FormatFlags) As String 563 If (x As Int64) < 0 Then 564 IntegerD_Prefix = "-" 381 565 ElseIf flags And Sign Then 382 IntegerD U_Prefix = "+"566 IntegerD_Prefix = "+" 383 567 ElseIf flags And Blank Then 384 IntegerD U_Prefix = " "568 IntegerD_Prefix = " " 385 569 End If 386 570 End Function … … 406 590 @date 2007/10/22 407 591 */ 408 Dim TraitsIntegerO As IntegerConvertTraits409 With TraitsIntegerO 592 Dim TraitsIntegerO[1] As IntegerConvertTraits 593 With TraitsIntegerO[0] 410 594 .Convert = AddressOf(IntegerO_Convert) 411 595 .Prefix = AddressOf(IntegerO_Prefix) … … 413 597 End With 414 598 415 /*! 416 @author Egtra 417 @date 2007/10/26 418 */ 419 Dim TraitsIntegerLO As IntegerConvertTraits 420 With TraitsIntegerLO 599 With TraitsIntegerO[1] 421 600 .Convert = AddressOf(IntegerLO_Convert) 422 601 .Prefix = AddressOf(IntegerO_Prefix) … … 435 614 */ 436 615 Function FormatIntegerO(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String 437 Return FormatIntegerEx(TraitsIntegerO , x, d, field, flags)616 Return FormatIntegerEx(TraitsIntegerO[0], x, d, field, flags) 438 617 End Function 439 618 … … 444 623 */ 445 624 Function FormatIntegerLO(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String 446 Return FormatIntegerEx(TraitsInteger LO, x, d, field, flags)625 Return FormatIntegerEx(TraitsIntegerO[1], x, d, field, flags) 447 626 End Function 448 627 … … 491 670 */ 492 671 Function IntegerO_Prefix(x As QWord, flags As FormatFlags) As String 672 If flags And BPrefix Then 673 If x <> 0 Then 674 IntegerO_Prefix = "&O" 675 End If 676 End If 493 677 End Function 494 678 … … 511 695 @date 2007/10/24 512 696 */ 513 Dim TraitsIntegerX As IntegerConvertTraits514 With TraitsIntegerX 697 Dim TraitsIntegerX[1] As IntegerConvertTraits 698 With TraitsIntegerX[0] 515 699 .Convert = AddressOf(IntegerX_Convert) 516 700 .Prefix = AddressOf(IntegerX_Prefix) … … 518 702 End With 519 703 520 /*! 521 @author Egtra 522 @date 2007/10/26 523 */ 524 Dim TraitsIntegerLX As IntegerConvertTraits 525 With TraitsIntegerLX 704 With TraitsIntegerX[1] 526 705 .Convert = AddressOf(IntegerLX_Convert) 527 706 .Prefix = AddressOf(IntegerX_Prefix) … … 540 719 */ 541 720 Function FormatIntegerX(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String 542 Return FormatIntegerEx(TraitsIntegerX , x, d, field, flags)721 Return FormatIntegerEx(TraitsIntegerX[0], x, d, field, flags) 543 722 End Function 544 723 … … 549 728 */ 550 729 Function FormatIntegerLX(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String 551 Return FormatIntegerEx(TraitsInteger LX, x, d, field, flags)730 Return FormatIntegerEx(TraitsIntegerX[1], x, d, field, flags) 552 731 End Function 553 732 … … 587 766 */ 588 767 Function IntegerX_Prefix(x As QWord, flags As FormatFlags) As String 589 If flags And AltThen590 If x <> 0Then768 If x <> 0 Then 769 If flags And Alt Then 591 770 IntegerX_Prefix = "0X" 771 ElseIf flags And BPrefix Then 772 IntegerX_Prefix = "&H" 592 773 End If 593 774 End If … … 598 779 @author Egtra 599 780 @date 2007/10/22 781 782 FormatIntegerの都合上、このファイル内で宣言しているIntegerConvertTraits型の 783 変数は全て配列となっている;[0]が32ビット変換、[1]が64ビット変換である。 600 784 */ 601 785 Type IntegerConvertTraits … … 701 885 End Sub 702 886 887 /*! 888 @brief 文字列をprintfの%s相当の変換で書式化する関数。 889 @author Egtra 890 @date 2007/10/27 891 @param[in] x 文字列。 892 @param[in] d 精度、最大の文字数。 893 @param[in] field フィールド幅。 894 @param[in] flags 書式フラグ。 895 @return 書式化された文字列。 896 */ 897 Function FormatString(x As String, d As DWord, field As DWord, flags As FormatFlags) As String 898 Dim sb = New System.Text.StringBuilder( 899 x, 0, System.Math.Min(x.Length As DWord, d) As Long, field) 900 AdjustFieldWidth(sb, field, flags And Left) 901 FormatString = sb.ToString() 902 End Function 903 904 /*! 905 @brief 文字をprintfの%c相当の変換で書式化する関数。 906 @author Egtra 907 @date 2007/10/27 908 @param[in] x 文字。 909 @param[in] d 精度、最大の文字数。 910 @param[in] field フィールド幅。 911 @param[in] flags 書式フラグ。 912 @return 書式化された文字列。 913 */ 914 Function FormatCharacter(x As StrChar, d As DWord, field As DWord, flags As FormatFlags) As String 915 Dim sb = New System.Text.StringBuilder(field + 1) 916 sb.Append(x) 917 AdjustFieldWidth(sb, field, flags And Left) 918 FormatCharacter = sb.ToString() 919 End Function 920 921 /*! 922 @author Egtra 923 @date 2007/10/28 924 */ 925 TypeDef FormatFloatProc = *Function(x As Double, precision As DWord, fieldWidth As DWord, flags As FormatFlags) As String 926 927 /*! 928 @author Egtra 929 @date 2007/10/28 930 */ 931 Sub FormatFloat(s As System.Text.StringBuilder, formatProc As FormatFloatProc, 932 param As Object, precision As DWord, field As DWord, flags As FormatFlags) 933 934 Dim x As Double 935 Dim typeName = param.GetType().FullName 936 If typeName = "System.Double" Then 937 x = param As System.Double 938 ElseIf typeName = "System.Single" Then 939 x = param As System.Single 940 End If 941 s.Append(formatProc(x, precision, field, flags)) 942 End Sub 943 944 /*! 945 @author Egtra 946 @date 2007/10/28 947 */ 948 Sub FormatInteger(s As System.Text.StringBuilder, traits As *IntegerConvertTraits, 949 param As Object, signed As Boolean, typeWidth As Long, precision As DWord, field As DWord, flags As FormatFlags) 950 951 Dim x As QWord 952 Dim typeName = param.GetType().FullName 953 If typeName = "System.UInt64" Then 954 x = param As System.UInt64 955 ElseIf typeName = "System.Int64" Then 956 x = (param As System.Int64) As QWord 957 ElseIf typeName = "System.UInt32" Then 958 x = param As System.UInt32 959 ElseIf typeName = "System.Int32" Then 960 x = (param As System.Int32) As QWord 961 ElseIf typeName = "System.UInt16" Then 962 x = param As System.UInt16 963 ElseIf typeName = "System.Int16" Then 964 x = (param As System.Int16) As QWord 965 ElseIf typeName = "System.UInt8" Then 966 x = param As System.Byte 967 ElseIf typeName = "System.Int8" Then 968 x = (param As System.SByte) As QWord 969 End If 970 '一旦縮めた後、符号・ゼロ拡張させる。 971 'また、64ビット整数なら64ビット変換Traitsを選択する。 972 If signed Then 973 If typeWidth = 1 Then 974 traits = VarPtr(traits[1]) 975 ElseIf typeWidth = 0 Then 976 x = (((x As DWord) As Long) As Int64) As QWord 977 ElseIf typeWidth = -1 Then 978 x = (((x As Word) As Integer) As Int64) As QWord 979 ElseIf typeWidth = -2 Then 980 x = (((x As Byte) As SByte) As Int64) As QWord 981 End If 982 Else 983 If typeWidth = 1 Then 984 traits = VarPtr(traits[1]) 985 ElseIf typeWidth = 0 Then 986 x = x As DWord 987 ElseIf typeWidth = -1 Then 988 x = x As Word 989 ElseIf typeWidth = -2 Then 990 x = x As Byte 991 End If 992 End If 993 994 s.Append(FormatIntegerEx(ByVal traits, x, precision, field, flags)) 995 End Sub 996 997 'Format関数群ここまで 998 '---- 999 1000 /*! 1001 @brief 文字列から数値への変換。さらに変換に使われなかった文字列の位置を返す。 1002 @author Egtra 1003 @date 2007/11/11 1004 @param[in] s 変換する文字 1005 @param[out] p 変換に使われなかった部分の先頭を指すポインタ 1006 @return 変換して得られた数値。変換できなければ0。 1007 */ 1008 Function StrToLong(s As *StrChar, ByRef p As *StrChar) As Long 1009 Dim negative As Boolean 1010 Dim i = 0 As Long 1011 If s[i] = &h2d Then 'Asc("-") 1012 i++ 1013 negative = True 1014 End If 1015 Do 1016 Dim c = s[i] 1017 If Not IsDigit(c) Then Exit Do 1018 StrToLong *= 10 1019 StrToLong += ((c As DWord) And &h0f) As Long 1020 i++ 1021 Loop 1022 If negative Then 1023 StrToLong = -StrToLong 1024 End If 1025 p = VarPtr(s[i]) 1026 End Function 1027 1028 /*! 1029 @brief 文字が十進数字かどうか調べる。 1030 @author Egtra 1031 @date 2007/11/11 1032 @param[in] c 調べる文字 1033 @retval True 0から9の文字である 1034 @retval False そうでない 1035 */ 1036 Function IsDigit(c As StrChar) As Boolean 1037 Dim dw = (c As DWord) 1038 IsDigit = (dw - &h30) < 10 1039 End Function 1040 1041 /*! 1042 @brief フィールド幅、精度用の数値読取 1043 @author Egtra 1044 @date 2007/11/11 1045 @param[in, out] fmt 読み途中の書式指定 1046 @param[in] params 1047 @param[in, out] paramsCount 1048 @param[out] ret 読み取った数値。読み取られなかったときの値は不定。 1049 @retval True 読取を行った 1050 @retval False 行わなかった 1051 fmt[0]が*のときにはparamsから1つ読み取る。 1052 そうでなく、fmtに数字(先頭に-符号があっても可)が並んでいれば、それを読み取る。 1053 */ 1054 Function ReadInt(ByRef fmt As *StrChar, params As *Object, ByRef paramsCount As SIZE_T, ByRef ret As Long) As Boolean 1055 If fmt[0] = &h2a Then '* 1056 fmt++ 'p 1057 ret = params[paramsCount] As System.Int32 1058 paramsCount++ 1059 ReadInt = True 1060 Else 1061 Dim p As PSTR 1062 ret = StrToLong(fmt, p) 1063 If fmt <> p Then 1064 fmt = p 1065 ReadInt = True 1066 Else 1067 ReadInt = False 1068 End If 1069 End If 1070 End Function 1071 1072 /*! 1073 @brief フラグ指定の読み込み 1074 @author Egtra 1075 @date 2007/10/28 1076 @param[in, out] fmt 1077 @param[out] flags 1078 @retval True 読み込みが完了した。 1079 @retval False 読み取り中に文字列が終了した(ヌル文字が現れた)。 1080 */ 1081 Function ReadFlags(ByRef fmt As *StrChar, ByRef flags As FormatFlags) As Boolean 1082 ReadFlags = False 1083 Do 1084 Select Case fmt[0] 1085 Case &h23 '# 1086 flags Or= Alt 1087 Case &h30 '0 1088 flags Or= Zero 1089 Case &h20 '空白 1090 flags Or= Blank 1091 Case &h2b '+ 1092 flags Or= Sign 1093 Case &h2d '- 1094 flags Or = Left 1095 Case &h26 '& 1096 flags Or= BPrefix 1097 Case 0 1098 Exit Function 1099 Case Else 1100 Exit Do 1101 End Select 1102 fmt++ 'p 1103 Loop 1104 ReadFlags = True 1105 End Function 1106 1107 /*! 1108 @brief フィールド幅指定の読み込み 1109 @author Egtra 1110 @date 2007/10/29 1111 @param[in, out] fmt 1112 @param[in] params 1113 @param[in, out] paramsCount 1114 @param[out] fieldWidth 1115 @param[in, out] flags 1116 */ 1117 Sub ReadFieldWidth(ByRef fmt As *StrChar, params As *Object, ByRef paramsCount As SIZE_T, 1118 ByRef fieldWidth As DWord, ByRef flags As FormatFlags) 1119 Dim t As Long 1120 If ReadInt(fmt, params, paramsCount, t) Then 1121 If t < 0 Then 1122 flags Or= Left 1123 fieldWidth = -t As DWord 1124 Else 1125 fieldWidth = t As DWord 1126 End If 1127 Else 1128 fieldWidth = 0 1129 End If 1130 End Sub 1131 1132 /*! 1133 @brief 精度の読み込み 1134 @author Egtra 1135 @date 2007/10/29 1136 @param[in, out] fmt 1137 @param[in] params 1138 @param[in, out] paramsCount 1139 @return 読み取った精度。指定がなかったときには、DWORD_MAX。 1140 */ 1141 Function ReadPrecision(ByRef fmt As *StrChar, 1142 params As *Object, ByRef paramsCount As SIZE_T) As DWord 1143 1144 If fmt[0] = &h2e Then '. 1145 fmt++ 1146 Dim t As Long 1147 ReadPrecision = 0 1148 If ReadInt(fmt, params, paramsCount, t) Then 1149 If t > 0 Then 1150 ReadPrecision = t As DWord 1151 End If 1152 End If 1153 Else 1154 ReadPrecision = DWORD_MAX 1155 End If 1156 End Function 1157 1158 /*! 1159 @biref 長さ指定の読み込み 1160 @author Egtra 1161 @date 2007/10/29 1162 @param[in, out] fmt 1163 @param[out] lengthSpec 1164 */ 1165 Sub ReadLength(ByRef fmt As *StrChar, ByRef lengthSpec As Long) 1166 Do 1167 Select Case fmt[0] 1168 Case &h6c 'l 1169 lengthSpec++ 1170 Case &h68 'h 1171 lengthSpec-- 1172 Case &h6a 'j (u)intmax_t 1173 lengthSpec = 1 1174 #ifdef _WIN64 1175 Case &h74 't ptrdiff_t 1176 lengthSpec = 1 1177 Case &h7a 'z (s)size_t, 1178 lengthSpec = 1 1179 #else 1180 Case &h74 't ptrdiff_t 1181 lengthSpec = 0 1182 Case &h7a 'z (s)size_t, 1183 lengthSpec = 0 1184 #endif 1185 Case Else 1186 Exit Sub 1187 End Select 1188 fmt++ 'p 1189 Loop 1190 End Sub 1191 1192 /*! 1193 @author Egtra 1194 @date 2007/10/27 1195 @todo %nへの対応 1196 */ 1197 Function SPrintf(format As String, params As *Object, n As SIZE_T) As String 1198 Dim i = 0 As DWord 1199 Dim paramsCount = 0 As SIZE_T 1200 Dim fmt = StrPtr(format) 1201 Dim s = New System.Text.StringBuilder 1202 Do 1203 Dim last = format.Length - (fmt - StrPtr(format)) As Long 'p 1204 Dim pos = ActiveBasic.Strings.ChrFind(fmt, last, &h25 As StrChar) '&h25 = % 1205 If pos = -1 Then 1206 s.Append(fmt, 0, last) 1207 Exit Do 1208 End If 1209 '%以前の部分 1210 s.Append(fmt, 0, pos) 1211 fmt += pos + 1 'p 1212 'フラグの読取 1213 Dim flags = None As FormatFlags 1214 If ReadFlags(fmt, flags) = False Then 1215 Exit Do 1216 End If 1217 'フィールド幅 1218 Dim fieldWidth As DWord 1219 ReadFieldWidth(fmt, params, i, fieldWidth, flags) 1220 '精度 1221 Dim precision = ReadPrecision(fmt, params, i) 1222 '幅指定の読取 1223 Dim typeWidth As Long 1224 ReadLength(fmt, typeWidth) 1225 1226 Select Case fmt[0] 1227 Case &h64 'd 1228 FormatInteger(s, TraitsIntegerD, params[i], True, typeWidth, precision, fieldWidth, flags) 1229 Case &h69 'i 1230 FormatInteger(s, TraitsIntegerD, params[i], True, typeWidth, precision, fieldWidth, flags) 1231 Case &h75 'u 1232 FormatInteger(s, TraitsIntegerU, params[i], False, typeWidth, precision, fieldWidth, flags) 1233 Case &h6f 'o 1234 FormatInteger(s, TraitsIntegerO, params[i], False, typeWidth, precision, fieldWidth, flags) 1235 Case &h4f 'O 1236 FormatInteger(s, TraitsIntegerO, params[i], False, typeWidth, precision, fieldWidth, flags Or Cap) 1237 Case &h78 'x 1238 FormatInteger(s, TraitsIntegerX, params[i], False, typeWidth, precision, fieldWidth, flags) 1239 Case &h58 'X 1240 FormatInteger(s, TraitsIntegerX, params[i], False, typeWidth, precision, fieldWidth, flags Or Cap) 1241 Case &h65 'e 1242 FormatFloat(s, AddressOf(FormatFloatE), params[i], precision, fieldWidth, flags) 1243 Case &h45 'E 1244 FormatFloat(s, AddressOf(FormatFloatE), params[i], precision, fieldWidth, flags Or Cap) 1245 Case &h66 'f 1246 FormatFloat(s, AddressOf(FormatFloatF), params[i], precision, fieldWidth, flags) 1247 Case &h46 'F 1248 FormatFloat(s, AddressOf(FormatFloatF), params[i], precision, fieldWidth, flags Or Cap) 1249 Case &h67 'g 1250 FormatFloat(s, AddressOf(FormatFloatG), params[i], precision, fieldWidth, flags) 1251 Case &h47 'G 1252 FormatFloat(s, AddressOf(FormatFloatG), params[i], precision, fieldWidth, flags Or Cap) 1253 Case &h61 'a 1254 FormatFloat(s, AddressOf(FormatFloatA), params[i], precision, fieldWidth, flags) 1255 Case &h41 'A 1256 FormatFloat(s, AddressOf(FormatFloatA), params[i], precision, fieldWidth, flags Or Cap) 1257 Case &h73 's 1258 s.Append(FormatString(params[i] As String, precision, fieldWidth, flags)) 1259 Case &h63 'c 1260 s.Append(FormatCharacter(params[i] As BoxedStrChar, precision, fieldWidth, flags)) 1261 ' Case &h6e 'n 1262 Case &h25 '% 1263 s.Append(&h25 As StrChar) 1264 i-- 1265 Case 0 1266 Exit Do 1267 End Select 1268 fmt++ 'p 1269 i++ 1270 Loop 1271 SPrintf = s.ToString 1272 End Function 1273 703 1274 End Namespace 'Detail 1275 1276 /*! 1277 @brief Cのsprintfのような書式化関数10引数版 1278 @author Egtra 1279 @date 2007/10/27 1280 @param[in] format 書式指定 1281 @param[in] paramN 引数 1282 @return 書式化された文字列 1283 */ 1284 1285 Function SPrintf(format As String, param0 As Object, 1286 param1 As Object, param2 As Object, param3 As Object, 1287 param4 As Object, param5 As Object, param6 As Object, 1288 param7 As Object, param8 As Object, param9 As Object) As String 1289 #ifdef _WIN64 1290 'コンパイラがどういうコードを吐くのかわからないので、安全策を取る。 1291 Dim params[9] = [param0, param1, param2, param3, param4, 1292 param5, param6, param7, param8, param9] As Object 1293 #else 1294 Dim params = VarPtr(param0) As *Object 1295 #endif 1296 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 10) 1297 End Function 1298 1299 /*! 1300 @brief Cのsprintfのような書式化関数9引数版 1301 @author Egtra 1302 @date 2007/10/27 1303 @param[in] format 書式指定 1304 @param[in] paramN 引数 1305 @return 書式化された文字列 1306 */ 1307 Function SPrintf(format As String, param0 As Object, 1308 param1 As Object, param2 As Object, param3 As Object, 1309 param4 As Object, param5 As Object, param6 As Object, 1310 param7 As Object, param8 As Object) As String 1311 #ifdef _WIN64 1312 Dim params[8] = [param0, param1, param2, param3, param4, 1313 param5, param6, param7, param8] As Object 1314 #else 1315 Dim params = VarPtr(param0) As *Object 1316 #endif 1317 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 9) 1318 End Function 1319 1320 /*! 1321 @brief Cのsprintfのような書式化関数8引数版 1322 @author Egtra 1323 @date 2007/10/27 1324 @param[in] format 書式指定 1325 @param[in] paramN 引数 1326 @return 書式化された文字列 1327 */ 1328 Function SPrintf(format As String, param0 As Object, 1329 param1 As Object, param2 As Object, param3 As Object, 1330 param4 As Object, param5 As Object, param6 As Object, 1331 param7 As Object) As String 1332 #ifdef _WIN64 1333 Dim params[7] = [param0, param1, param2, param3, param4, 1334 param5, param6, param7] As Object 1335 #else 1336 Dim params = VarPtr(param0) As *Object 1337 #endif 1338 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 8) 1339 End Function 1340 1341 /*! 1342 @brief Cのsprintfのような書式化関数7引数版 1343 @author Egtra 1344 @date 2007/10/27 1345 @param[in] format 書式指定 1346 @param[in] paramN 引数 1347 @return 書式化された文字列 1348 */ 1349 Function SPrintf(format As String, param0 As Object, 1350 param1 As Object, param2 As Object, param3 As Object, 1351 param4 As Object, param5 As Object, param6 As Object) As String 1352 #ifdef _WIN64 1353 Dim params[6] = [param0, param1, param2, param3, param4, 1354 param5, param6] As Object 1355 #else 1356 Dim params = VarPtr(param0) As *Object 1357 #endif 1358 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 7) 1359 End Function 1360 1361 /*! 1362 @brief Cのsprintfのような書式化関数6引数版 1363 @author Egtra 1364 @date 2007/10/27 1365 @param[in] format 書式指定 1366 @param[in] paramN 引数 1367 @return 書式化された文字列 1368 */ 1369 Function SPrintf(format As String, param0 As Object, 1370 param1 As Object, param2 As Object, param3 As Object, 1371 param4 As Object, param5 As Object) As String 1372 #ifdef _WIN64 1373 Dim params[5] = [param0, param1, param2, param3, param4, 1374 param5] As Object 1375 #else 1376 Dim params = VarPtr(param0) As *Object 1377 #endif 1378 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 6) 1379 End Function 1380 1381 /*! 1382 @brief Cのsprintfのような書式化関数5引数版 1383 @author Egtra 1384 @date 2007/10/27 1385 @param[in] format 書式指定 1386 @param[in] paramN 引数 1387 @return 書式化された文字列 1388 */ 1389 Function SPrintf(format As String, param0 As Object, 1390 param1 As Object, param2 As Object, param3 As Object, 1391 param4 As Object) As String 1392 #ifdef _WIN64 1393 Dim params[4] = [param0, param1, param2, param3, param4] As Object 1394 #else 1395 Dim params = VarPtr(param0) As *Object 1396 #endif 1397 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 5) 1398 End Function 1399 1400 /*! 1401 @brief Cのsprintfのような書式化関数4引数版 1402 @author Egtra 1403 @date 2007/10/27 1404 @param[in] format 書式指定 1405 @param[in] paramN 引数 1406 @return 書式化された文字列 1407 */ 1408 Function SPrintf(format As String, param0 As Object, 1409 param1 As Object, param2 As Object, param3 As Object) As String 1410 #ifdef _WIN64 1411 Dim params[3] = [param0, param1, param2, param3] As Object 1412 #else 1413 Dim params = VarPtr(param0) As *Object 1414 #endif 1415 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 4) 1416 End Function 1417 1418 /*! 1419 @brief Cのsprintfのような書式化関数3引数版 1420 @author Egtra 1421 @date 2007/10/27 1422 @param[in] format 書式指定 1423 @param[in] paramN 引数 1424 @return 書式化された文字列 1425 */ 1426 Function SPrintf(format As String, param0 As Object, 1427 param1 As Object, param2 As Object) As String 1428 #ifdef _WIN64 1429 Dim params[2] = [param0, param1, param2] As Object 1430 #else 1431 Dim params = VarPtr(param0) As *Object 1432 #endif 1433 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 3) 1434 End Function 1435 1436 /*! 1437 @brief Cのsprintfのような書式化関数2引数版 1438 @author Egtra 1439 @date 2007/10/27 1440 @param[in] format 書式指定 1441 @param[in] paramN 引数 1442 @return 書式化された文字列 1443 */ 1444 Function SPrintf(format As String, param0 As Object, 1445 param1 As Object) As String 1446 #ifdef _WIN64 1447 Dim params[1] = [param0, param1] As Object 1448 #else 1449 Dim params = VarPtr(param0) As *Object 1450 #endif 1451 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 2) 1452 End Function 1453 1454 /*! 1455 @brief Cのsprintfのような書式化関数1引数版 1456 @author Egtra 1457 @date 2007/10/27 1458 @param[in] format 書式指定 1459 @param[in] paramN 引数 1460 @return 書式化された文字列 1461 */ 1462 Function SPrintf(format As String, param0 As Object) As String 1463 Dim params = VarPtr(param0) As *Object 1464 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 1) 1465 End Function 1466 1467 /*! 1468 @brief Cのsprintfのような書式化関数0引数版 1469 @author Egtra 1470 @date 2007/10/27 1471 @param[in] format 書式指定 1472 @param[in] paramN 引数 1473 @return 書式化された文字列 1474 */ 1475 Function SPrintf(format As String) As String 1476 SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, 0, 0) 1477 End Function 704 1478 705 1479 End Namespace 'Strings -
trunk/Include/Classes/ActiveBasic/Strings/Strings.ab
r370 r383 11 11 12 12 Sub ChrFill(p As PWSTR, n As SIZE_T, c As WCHAR) 13 Dim i As SIZE_T14 For i = 0 To ELM(n)13 Dim i = 0 As SIZE_T 14 While i <> n 15 15 p[i] = c 16 Next 16 i++ 17 Wend 17 18 End Sub 18 19 19 20 Sub ChrFill(p As PSTR, n As SIZE_T, c As SByte) 20 Dim i As SIZE_T21 For i = 0 To ELM(n)21 Dim i = 0 As SIZE_T 22 While i <> n 22 23 p[i] = c 23 Next 24 i++ 25 Wend 24 26 End Sub 25 27 … … 105 107 106 108 Function ChrPBrk(str As PCWSTR, cStr As SIZE_T, chars As PCWSTR, cChars As SIZE_T) As SIZE_T 107 Dim i As SIZE_T108 For i = 0 To ELM(cStr)109 Dim i = 0 As SIZE_T 110 While i <> cStr 109 111 If ChrFind(chars, cChars, str[i]) <> -1 Then 110 112 Return i 111 113 End If 112 Next 114 i++ 115 Wend 113 116 Return -1 As SIZE_T 114 117 End Function 115 118 116 119 Function ChrPBrk(str As PCSTR, cStr As SIZE_T, Chars As PCSTR, cChars As SIZE_T) As SIZE_T 117 Dim i As SIZE_T118 For i = 0 To ELM(cStr)120 Dim i = 0 As SIZE_T 121 While i <> cStr 119 122 If ChrFind(Chars, cChars, str[i]) <> -1 Then 120 123 Return i 121 124 End If 122 Next 125 i++ 126 Wend 123 127 Return -1 As SIZE_T 124 128 End Function 125 129 126 130 Function ChrFind(s As PCWSTR, size As SIZE_T, c As WCHAR) As SIZE_T 127 Dim i As SIZE_T128 For i = 0 To ELM(size)131 Dim i = 0 As SIZE_T 132 While i <> size 129 133 If s[i] = c Then 130 134 Return i 131 135 End If 132 Next 136 i++ 137 Wend 133 138 Return -1 As SIZE_T 134 139 End Function 135 140 136 141 Function ChrFind(s As PCSTR, size As SIZE_T, c As CHAR) As SIZE_T 137 Dim i As SIZE_T138 For i = 0 To ELM(size)142 Dim i = 0 As SIZE_T 143 While i <> size 139 144 If s[i] = c Then 140 145 Return i 141 146 End If 142 Next 147 i++ 148 Wend 143 149 Return -1 As SIZE_T 144 150 End Function … … 210 216 Loop 211 217 End Function 218 212 219 End Namespace 'Detail 213 220 -
trunk/Include/Classes/System/String.ab
r370 r383 6 6 7 7 #ifdef __STRING_IS_NOT_ALWAYS_UNICODE 8 9 #ifndef UNICODE 8 10 TypeDef StrChar = Char 9 #ifndef UNICODE10 11 #define __STRING_IS_NOT_UNICODE 11 12 #endif 13 14 #endif 15 16 #ifndef __STRING_IS_NOT_UNICODE 17 TypeDef StrChar = WCHAR 18 19 #ifdef UNICODE 20 #define __STRING_IS_UNICODE 12 21 #else 13 TypeDef StrChar = WCHAR14 #ifndef UNICODE15 22 #define __STRING_UNICODE_WINDOWS_ANSI 16 23 #endif … … 77 84 Assign(initStr + start, length) 78 85 End Sub 79 86 80 87 Sub String(initStr As String) 81 88 If Not String.IsNullOrEmpty(initStr) Then … … 592 599 End If 593 600 End Sub 594 601 595 602 Const Sub rangeCheck(start As Long, length As Long) 596 603 If start < 0 Or start > This.m_Length Or length < 0 Then -
trunk/Include/Classes/System/Text/StringBuilder.ab
r370 r383 520 520 If Not String.IsNullOrEmpty(s) Then 521 521 s.CopyTo(startIndex, chars, 0, length) 522 size = s.Length522 size = length 523 523 End If 524 524 End Sub -
trunk/Include/basic/function.sbp
r355 r383 174 174 'Abs = System.Math.Abs(number) 175 175 If number < 0 then 176 return -number 177 Else 178 return number 176 Abs = -number 177 Else 178 Abs = number 179 End If 180 End Function 181 182 Function Abs(number As Int64) As Int64 183 If number < 0 then 184 Abs = -number 185 Else 186 Abs = number 187 End If 188 End Function 189 190 Function Abs(number As Long) As Long 191 If number < 0 then 192 Abs = -number 193 Else 194 Abs = number 179 195 End If 180 196 End Function … … 240 256 241 257 #ifndef __STRING_IS_NOT_UNICODE 242 Function AscW(s As *WCHAR) As UCSCHAR258 Function AscW(s As String) As UCSCHAR 243 259 If s.Length = 0 Then 244 260 AscW = 0 -
trunk/Include/crt.sbp
r300 r383 65 65 #endif 66 66 67 Declare Function strtol CDecl Lib _CrtDllName (s As PCSTR, ByRef endPtr As PSTR, base As Long) As Long 68 Declare Function wcstol CDecl Lib _CrtDllName (s As PCWSTR, ByRef endPtr As PWSTR, base As Long) As Long 69 70 #ifdef UNICODE 71 Declare Function _tcstol CDecl Lib _CrtDllName Alias "wcstol" (s As PCTSTR, ByRef endPtr As PTSTR, base As Long) As Long 72 #else 73 Declare Function _tcstol CDecl Lib _CrtDllName Alias "strtol" (s As PCTSTR, ByRef endPtr As PTSTR, base As Long) As Long 74 #endif 75 67 76 68 77 #endif '_INC_CRT -
trunk/Include/system/string.sbp
r370 r383 265 265 End Function 266 266 267 #ifdef __STRING_IS_NOT_UNICODE 268 Typedef BoxedStrChar = System.SByte 269 #else 270 TypeDef BoxedStrChar = System.UInt16 271 #endif 272 267 273 #endif '_INC_BASIC_STRING
Note:
See TracChangeset
for help on using the changeset viewer.