- Timestamp:
- Oct 13, 2007, 2:11:22 PM (17 years ago)
- Location:
- trunk
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab
r335 r355 119 119 End If 120 120 121 Dim e As Long, signAs Boolean122 Dim s = FloatToChars(x, e, sign)123 124 If signThen121 Dim e As Long, negative As Boolean 122 Dim s = FloatToChars(x, e, negative) 123 124 If negative Then 125 125 .Append("-") 126 126 Else … … 151 151 End If 152 152 153 Dim buf[1023] As TCHAR 154 wsprintf(buf, "%03d", e)' "%+03d", e) wsprintfは+フラグが使えない! 155 Dim ts = New String(buf, 3) 156 .Append(ts) 157 '.Append(FormatLongD(e, 3, 0, Sign) 158 159 If .Length < field Then 160 Dim embeddedSize = .Length - field 161 If flags And Left Then 162 .Append(&h20, embeddedSize) 163 Else 164 Dim insPos As Long 165 If flags And Blank Then 166 insPos++ 167 End If 168 .Insert(insPos, String$(embeddedSize, " ")) 169 End If 170 End If 153 .Append(FormatIntegerD(e, 2, 0, Sign Or Zero)) 154 155 AdjustFieldWidth(sb, field, negative, flags) 171 156 End With 172 157 FormatFloatE = sb.ToString() … … 174 159 175 160 '! DWordの最大値4294967295の文字数 - 1。FormatIntegerU内で使用。 176 Const MaxSize = 9161 Const MaxSizeU = 9 177 162 178 163 /*! … … 187 172 */ 188 173 Function FormatIntegerU(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String 189 'zero, left 190 174 FormatIntegerU = FormatInteger(x, d, field, flags, 0) 175 End Function 176 177 '! Longの最大値2147483647, -2147483648の符号部を除く文字数 - 1。FormatIntegerU内で使用。 178 Const MaxSizeD = 9 179 180 /*! 181 @brief 符号有り整数をprintfの%u相当の変換で文字列化する関数。 182 @author Egtra 183 @date 2007/10/13 184 @param[in] x 文字列化する整数値。 185 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 186 @param[in] field フィールド幅。 187 @param[in] flags 書式フラグ。 188 @return xの文字列表現 189 */ 190 Function FormatIntegerD(x As Long, d As DWord, field As DWord, flags As FormatFlags) As String 191 Dim dwX As DWord 192 193 Dim signChar As StrChar 194 If x < 0 Then 195 dwX = (-x) As DWord 196 signChar = Asc("-") 197 Else 198 dwX = x As DWord 199 If flags And Sign Then 200 signChar = Asc("+") 201 ElseIf flags And Blank Then 202 signChar = Asc(" ") 203 End If 204 End If 205 206 FormatIntegerD = FormatInteger(dwX, d, field, flags, signChar) 207 End Function 208 209 /*! 210 @brief 整数をprintfの%d, %u相当の変換で文字列化する関数。 211 @author Egtra 212 @date 2007/09/18 213 @param[in] x 文字列化する整数値。 214 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 215 @param[in] field フィールド幅。 216 @param[in] flags 書式フラグ。 217 @param[in] signChar 符号部分の文字。\0なら存在しないとして扱われる。 218 @return xの文字列表現 219 */ 220 Function FormatInteger(x As DWord, d As DWord, field As DWord, flags As FormatFlags, signChar As StrChar) As String 191 221 '左揃えのときまたは精度が指定されているとき、ゼロフラグは無視される。 192 222 If (flags And Left) Or (d <> DWORD_MAX) Then … … 200 230 Dim sb = New System.Text.StringBuilder 201 231 With sb 202 Dim buf[MaxSize] As StrChar 203 Dim i = MaxSize 232 If signChar <> 0 Then 233 .Append(signChar) 234 End If 235 236 Dim buf[MaxSizeU] As StrChar 237 Dim i = MaxSizeU 204 238 While x <> 0 205 239 buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策 … … 208 242 Wend 209 243 210 Dim len = (MaxSize - i) As Long244 Dim len = (MaxSizeU - i) As Long 211 245 If len < d Then 212 246 .Append(&h30 As StrChar, d - len) … … 215 249 .Append(buf, i + 1, len) 216 250 217 If field > len Then 218 Dim embeddedSize = field - len 251 AdjustFieldWidth(sb, field, signChar <> 0, flags And (Not (Sign Or Blank))) 252 End With 253 FormatInteger = sb.ToString() 254 End Function 255 256 '! QWordの最大値18446744073709551615の文字数 - 1。FormatIntegerLU内で使用。 257 Const MaxSizeLU = 19 258 259 /*! 260 @brief 文字列をフィールド幅まで満たされるように空白などを挿入する。 261 @param [in,out] sb 対象文字列 262 @param [in] field フィールド幅 263 @param [in] hasSign 符号を持っている(負の値か)か否か 264 @param [in] flags フラグ 265 */ 266 Sub AdjustFieldWidth(sb As System.Text.StringBuilder, field As DWord, hasSign As Boolean, flags As FormatFlags) 267 With sb 268 If .Length < field Then 269 Dim embeddedSize = field - .Length 219 270 If flags And Left Then 220 271 .Append(&h20, embeddedSize) 221 272 Else 222 .Insert(0, String$(embeddedSize, " ")) 273 Dim insPos As Long 274 If (flags And Zero) <> 0 Then 275 If ((flags And Blank) Or (flags And Sign) Or hasSign) Then 276 insPos++ 277 End If 278 .Insert(insPos, String$(embeddedSize, "0")) 279 Else 280 .Insert(insPos, String$(embeddedSize, " ")) 281 End If 223 282 End If 224 283 End If 284 225 285 End With 226 FormatIntegerU = sb.ToString() 227 End Function 286 End Sub 228 287 229 288 End Namespace 'Detail -
trunk/Include/Classes/ActiveBasic/Strings/Strings.ab
r272 r355 193 193 194 194 Namespace Detail 195 Function Split(s As String, c As StrChar) As /*System.*/ArrayList '暫定196 Split = New /*System.*/ArrayList195 Function Split(s As String, c As StrChar) As System.Collections.ArrayList 196 Split = New System.Collections.ArrayList 197 197 198 198 Dim last = 0 As Long -
trunk/Include/Classes/System/Collections/ArrayList.ab
r309 r355 2 2 3 3 #require <Classes/System/Collections/misc.ab> 4 5 Namespace System 6 Namespace Collections 4 7 5 8 Class ArrayList … … 351 354 End Class 352 355 353 /* 354 Class ArrayList_Element 355 Public 356 Sub ArrayList_Element() 357 Init(0) 358 End Sub 359 Sub ArrayList_Element(c As Long) 360 Init(c) 361 End Sub 362 363 Sub ~ArrayList_Element() 364 free(Elm) 365 End Sub 366 367 Sub Init(c As Long) 368 If c > 0 Then 369 Elm = malloc(SizeOf (*Object) * c) 370 If Elm = 0 Then 371 ' OutOfMemoryException 372 Debug 373 End If 374 Else 375 Elm = 0 376 End If 377 Size = 0 378 Capacity = c 379 End Sub 380 381 Sub Swap(ByRef x As ArrayList_Element) 382 Dim tmpElm = x.Elm 383 x.Elm = This.Elm 384 This.Elm = tmpElm 385 386 Dim tmpSize = x.Size 387 x.Size = This.Size 388 This.Size = x.Size 389 390 Dim tmpCap = x.Capacity 391 x.Capacity = This.Capacity 392 This.Capacity = tmpCap 393 End Sub 394 395 Elm As **Object 396 Size As Long 397 Capacity As Long 398 End Class 399 */ 356 End Namespace 'Collections 357 End Namespace 'System -
trunk/Include/Classes/System/Collections/misc.ab
r195 r355 3 3 #ifndef __SYSTEM_COLLECTIONS_MISC_AB__ 4 4 #define __SYSTEM_COLLECTIONS_MISC_AB__ 5 6 Namespace System 7 Namespace Collections 5 8 6 9 Interface ICollection … … 114 117 End Class 115 118 119 End Namespace 'Collections 120 End Namespace 'System 121 116 122 #endif '__SYSTEM_COLLECTIONS_MISC_AB__ -
trunk/Include/Classes/index.ab
r353 r355 2 2 #require "./ActiveBasic/Core/TypeInfo.ab" 3 3 #require "./ActiveBasic/Math/Math.ab" 4 #require "./ActiveBasic/Strings/SPrintF.ab"4 '#require "./ActiveBasic/Strings/SPrintF.ab" 5 5 #require "./ActiveBasic/Strings/Strings.ab" 6 6 #require "./ActiveBasic/Windows/CriticalSection.ab" -
trunk/Include/basic/function.sbp
r303 r355 1019 1019 End Function 1020 1020 1021 /*! 1022 @brief ABオブジェクトを指すポインタをObject型へ変換。 1023 @author Egtra 1024 @date 2007/08/24 1025 @param[in] p COMインタフェースを指すポインタ 1026 @return Object参照型 1027 */ 1021 1028 Function _System_PtrObj(p As VoidPtr) As Object 1022 1029 SetPointer(VarPtr(_System_PtrObj), p) 1030 End Function 1031 1032 /*! 1033 @brief IUnknownその他COMインタフェースを指すポインタをIUnknown参照型へ変換。 1034 @author Egtra 1035 @date 2007/09/24 1036 @param[in] p COMインタフェースを指すポインタ 1037 @return IUnknown参照型 1038 */ 1039 Function _System_PtrUnknown(p As VoidPtr) As IUnknown 1040 SetPointer(VarPtr(_System_PtrUnknown), p) 1023 1041 End Function 1024 1042 -
trunk/Include/com/currency.ab
r335 r355 56 56 Return ret 57 57 End Function 58 58 /* 59 59 Const Function Operator /(y As Variant) As Double 60 60 Dim vx = New Variant(This) 61 61 Dim ret = vx / y 62 Return ret.ValR 462 Return ret.ValR8 63 63 End Function 64 64 … … 67 67 Dim vy = New Variant(y) 68 68 Dim ret = vx / vy 69 Return ret.ValR 470 End Function 71 69 Return ret.ValR8 70 End Function 71 */ 72 72 Const Function Operator +(y As Currency) As Currency 73 73 Dim ret = New Currency -
trunk/Include/com/decimal.ab
r335 r355 15 15 Sub Decimal(d As Decimal) 16 16 ' dec = d なぜかコンパイルできない 17 memcpy(VarPtr(dec), VarPtr(d.dec), Len(dec)) 18 End Sub 19 20 Sub Decimal(ByRef d As DECIMAL) 17 21 memcpy(VarPtr(dec), VarPtr(d), Len(dec)) 18 22 End Sub … … 340 344 341 345 Const Function ToVariant() As Variant 342 Return New Variant( dec)346 Return New Variant(This) 343 347 End Function 344 348 -
trunk/Include/com/index.ab
r211 r355 3 3 #require <com/bstring.ab> 4 4 #require <com/variant.ab> 5 #require <com/vbobject.ab>5 '#require <com/vbobject.ab> 6 6 #require <com/currency.ab> 7 7 #require <com/decimal.ab> -
trunk/Include/com/variant.ab
r335 r355 6 6 '#require <oaidl.ab> 7 7 '#require <oleauto.ab> 8 #require <com/index.ab>8 '#require <com/index.ab> 9 9 10 10 Namespace ActiveBasic … … 109 109 110 110 Sub Variant(s As String) 111 Dim bs As BString(s) 112 Variant(bs) 111 ValStr = New BString(s) 113 112 End Sub 114 113 … … 118 117 End Sub 119 118 119 Sub Variant(n As Decimal) 120 Dim p = VarPtr(v) As *DECIMAL 121 p[0] = n.Dec 122 v.vt = VT_DECIMAL 123 End Sub 124 120 125 121 126 Sub ~Variant() … … 127 132 v.vt = VT_EMPTY 128 133 End Sub 129 /* 130 Sub Operator =(y As Variant) 131 Assign(y.v) 132 End Sub 133 134 Sub Operator =(y As VARIANT) 135 Assign(y) 136 End Sub 137 */ 134 138 135 Sub Assign(from As Variant) 139 136 Assign(from.v) … … 171 168 */ 172 169 'Operators 173 170 /* 174 171 Const Function Operator ^(y As Variant) As Variant 175 172 Dim ret = New Variant … … 265 262 Return ret 266 263 End Function 267 264 */ 268 265 Const Function Abs() As Variant 269 Dim ret = New Variant 270 VarAbs(This.v, ret.v) 271 Return ret 266 Abs = New Variant 267 VarAbs(This.v, Abs.v) 272 268 End Function 273 269 274 270 Const Function Fix() As Variant 275 Dim ret = New Variant 276 VarFix(This.v, ret.v) 277 Return ret 271 Fix = New Variant 272 VarFix(This.v, Fix.v) 278 273 End Function 279 274 280 275 Const Function Int() As Variant 281 Dim ret = New Variant 282 VarInt(This.v, ret.v) 283 Return ret 284 End Function 285 286 Const Function Round(cDecimals As Long) As Variant 287 Dim ret = New Variant 288 VarRound(This.v, cDecimals, ret) 289 Return ret 290 End Function 291 292 Const Function Round() As Variant 293 Return Round(0) 276 Int = New Variant 277 VarInt(This.v, Int.v) 278 End Function 279 280 Const Function Round(cDecimals = 0 As Long) As Variant 281 Round = New Variant 282 VarRound(This.v, cDecimals, Round.v) 294 283 End Function 295 284 … … 301 290 Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意 302 291 End Function 303 292 /* 304 293 Const Function Operator ==(y As Variant) As Boolean 305 294 Dim c = Compare(This, y) … … 338 327 End Function 339 328 */ 329 /* 340 330 Const Function Operator <=(y As Variant) As Boolean 341 331 Dim c = Compare(This, y) … … 355 345 End If 356 346 End Function 357 347 */ 358 348 Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant 359 349 Dim ret = New Variant … … 435 425 Const Function ValI1() As SByte 436 426 Dim r = ChangeType(VT_I1) 437 Return GetByte(VarPtr(r.v al)) As SByte427 Return GetByte(VarPtr(r.v.val)) As SByte 438 428 End Function 439 429 … … 446 436 Const Function ValI2() As Integer 447 437 Dim r = ChangeType(VT_I2) 448 Return GetWord(VarPtr(r.v al)) As Integer438 Return GetWord(VarPtr(r.v.val)) As Integer 449 439 End Function 450 440 … … 457 447 Const Function ValI4() As Long 458 448 Dim r = ChangeType(VT_I4) 459 Return GetDWord(VarPtr(r.v al)) As Long449 Return GetDWord(VarPtr(r.v.val)) As Long 460 450 End Function 461 451 … … 468 458 Const Function ValI8() As Int64 469 459 Dim r = ChangeType(VT_I8) 470 Return GetQWord(VarPtr(r.v al)) As Int64460 Return GetQWord(VarPtr(r.v.val)) As Int64 471 461 End Function 472 462 … … 479 469 Const Function ValR4() As Single 480 470 Dim r = ChangeType(VT_R4) 481 Return GetSingle(VarPtr(r.v al))471 Return GetSingle(VarPtr(r.v.val)) 482 472 End Function 483 473 … … 490 480 Const Function ValR8() As Double 491 481 Dim r = ChangeType(VT_UI8) 492 Return GetDouble(VarPtr(r.v al))482 Return GetDouble(VarPtr(r.v.val)) 493 483 End Function 494 484 … … 512 502 Const Function ValError() As SCODE 513 503 Dim r = ChangeType(VT_ERROR) 514 Return GetDWord(VarPtr(r.v al))504 Return GetDWord(VarPtr(r.v.val)) 515 505 End Function 516 506 … … 524 514 Dim r = ChangeType(VT_CY) 525 515 ValCy = New Currency 526 ValCy.Cy = GetQWord(VarPtr(r.v al))516 ValCy.Cy = GetQWord(VarPtr(r.v.val)) 527 517 End Function 528 518 … … 561 551 v.vt = VT_UNKNOWN 562 552 End Sub 563 553 /* 564 554 Const Function ValObject() As VBObject 565 555 Dim r As VARIANT … … 576 566 v.vt = VT_DISPATH 577 567 End Sub 578 568 */ 579 569 'ValArray 580 570 581 571 Const Function ValDecimal() As Decimal 582 572 Dim p = VarPtr(v) As *Decimal 583 Return New Deciaml( p[0])573 Return New Deciaml(ByVal p) 584 574 End Function 585 575 586 576 Sub ValDecimal(x As Decimal) 587 577 Clear() 588 Dim p = VarPtr(v) As *D ecimal578 Dim p = VarPtr(v) As *DECIMAL 589 579 p[0] = x.Dec 590 580 v.vt = VT_DECIMAL '念の為 … … 599 589 ' If _System_VariantOptionalParam = Nothing Then 600 590 ' 'ToDo マルチスレッド対応 601 _System_VariantOptionalParam = New Variant602 _System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND591 VariantOptionalParam = New Variant 592 VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND 603 593 ' End If 604 Return _System_VariantOptionalParam594 Return VariantOptionalParam 605 595 End Function 606 596 Private … … 617 607 End Class 618 608 619 'Dim _System_VariantOptionalParam = Nothing As Variant609 Dim VariantOptionalParam = Nothing As Variant 620 610 621 611 /* -
trunk/Include/com/vbobject.ab
r335 r355 295 295 Return CallByName 296 296 End Function 297 297 /* 298 298 Function CreateObject(className As PCWSTR) As VBObject 299 299 Return New VBObject(className, 0, CLSCTX_ALL) -
trunk/TestCase/SimpleTestCase/DelegateTest.ab
r352 r355 1 /* 1 2 Namespace DelegateTest 2 3 … … 96 97 97 98 DelegateTest.TestMain() 99 */ -
trunk/TestCase/SimpleTestCase/SPrintFTest.ab
r337 r355 2 2 ' Test case of SPrintF Function and etc... 3 3 '-------------------------------------------------------------------- 4 5 #require <Classes/ActiveBasic/Strings/SPrintF.ab> 4 6 5 7 Imports ActiveBasic.Strings … … 21 23 22 24 s = FormatFloatE(9.876543e021, 6, 0, None) 23 UnitTest("FormatFloatE(9876543e 021)", s = "9.876543e021")25 UnitTest("FormatFloatE(9876543e+21)", s = "9.876543e+21") 24 26 25 s = FormatFloatE(7.81250000E-003, 8, 0, Cap) 26 UnitTest("FormatFloatE(7.81250000E-003)", s = "7.81250000E-003") 27 /* 28 上は、現在s = 7.81250000E-03となり失敗する。 29 FormatIntegerDを作成していないことが要因。 30 */ 27 s = FormatFloatE(7.81250000E-03, 8, 0, Cap) 28 UnitTest("FormatFloatE(7.81250000E-03)", s = "7.81250000E-03") 29 30 s = FormatFloatE(1.2345e67, 4, 15, 0) 31 UnitTest("FormatFloatE(1.2345e+67, field width = 15)", s = " 1.2345e+67") 32 s = FormatFloatE(1.2345e67, 4, 15, Zero) 33 UnitTest("FormatFloatE(1.2345e+67, field width = 15, Zero)", s = "000001.2345e+67") 34 s = FormatFloatE(-1.2345e67, 4, 15, 0) 35 UnitTest("FormatFloatE(-1.2345e+67, field width = 15)", s = " -1.2345e+67") 36 s = FormatFloatE(-1.2345e67, 4, 15, Zero) 37 UnitTest("FormatFloatE(-1.2345e+67, field width = 15, Zero)", s = "-00001.2345e+67") 38 s = FormatFloatE(1.2345e67, 4, 15, Sign) 39 UnitTest("FormatFloatE(1.2345e+67, field width = 15, Sign)", s = " +1.2345e+67") 40 s = FormatFloatE(1.2345e67, 4, 15, Zero Or Sign) 41 UnitTest("FormatFloatE(1.2345e+67, field width = 15, Zero Or Sign)", s = "+00001.2345e+67") 42 s = FormatFloatE(1.2345e67, 4, 15, Zero Or Blank) 43 UnitTest("FormatFloatE(1.2345e+67, field width = 15, Zero Or Blank)", s = " 00001.2345e+67") 44 s = FormatFloatE(-1.2345e67, 4, 15, Zero Or Sign) 45 UnitTest("FormatFloatE(-1.2345e+67, field width = 15, Zero Or Sign)", s = "-00001.2345e+67") 46 s = FormatFloatE(-1.2345e67, 4, 15, Zero Or Blank) 47 UnitTest("FormatFloatE(-1.2345e+67, field width = 15, Zero Or Blank)", s = "-00001.2345e+67") 48 49 s = FormatFloatE(1.2345e+67, 4, 0, Cap) 50 UnitTest("FormatFloatE(1.2345E+67, Cap)", s = "1.2345E+67") 51 52 s = FormatFloatE(1.2345e67, 3, 0, None) 53 UnitTest("FormatFloatE(1.2345e+67, precision = 3)", s = "1.234e+67") 54 31 55 32 56 s = FormatIntegerU(777, 0, 0, None) … … 34 58 35 59 s = FormatIntegerU(513, 0, 5, None) 36 UnitTest("FormatIntegerU(513, Field size = 5)", s = " 513") 60 UnitTest("FormatIntegerU(513, field width = 5)", s = " 513") 61 62 s = FormatIntegerD(-3, 2, 0, Sign) 63 UnitTest("FormatIntegerD(-3, precision = 2)", s = "-03") 64 65 s = FormatIntegerD(3, 0, 5, Sign) 66 UnitTest("FormatIntegerD(+3, field width = 5)", s = " +3") 67 68 ' s = FormatIntegerLU(8589934590, DWORD_MAX, 0, None) 69 ' UnitTest("FormatIntegerLU(8589934590)", s = "8589934590") 70 71 37 72 38 73 End Sub -
trunk/TestCase/SimpleTestCase/SimpleTestCase.ab
r236 r355 2 2 3 3 #console 4 5 Dim hStdOut = _System_hConsoleOut 6 7 Dim csbi As CONSOLE_SCREEN_BUFFER_INFO 8 GetConsoleScreenBufferInfo(hStdOut, csbi) 9 4 10 #include "SimpleTestCase.idx" 5 11 … … 7 13 Dim resultStr As String 8 14 If isSuccessful Then 9 resultStr = Ex"OK \t"15 resultStr = Ex"OK " 10 16 Else 11 17 resultStr = Ex"FAILURE!" 12 18 End If 13 19 14 Print resultStr, msg 20 If Not isSuccessful Then 21 SetConsoleTextAttribute(hStdOut, BACKGROUND_RED Or BACKGROUND_GREEN Or BACKGROUND_INTENSITY) 22 End If 23 24 Print resultStr; msg 25 26 If Not isSuccessful Then 27 SetConsoleTextAttribute(hStdOut, csbi.wAttributes) 28 End If 15 29 End Function 16 30 -
trunk/TestCase/SimpleTestCase/SimpleTestCase.pj
r352 r355 7 7 #NAME=SimpleTestCase 8 8 9 #PLATFORM= 649 #PLATFORM=32 10 10 11 11 #USEWINDOW=0
Note:
See TracChangeset
for help on using the changeset viewer.