Changeset 355 for trunk/Include


Ignore:
Timestamp:
Oct 13, 2007, 2:11:22 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

FormatIntegerDを実装。
UnitTestの失敗時の表示を目立つようにした。
ArrayListを名前空間System.Collectionsに入れた。

Location:
trunk/Include
Files:
11 edited

Legend:

Unmodified
Added
Removed

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

    r335 r355  
    119119        End If
    120120
    121         Dim e As Long, sign As Boolean
    122         Dim s = FloatToChars(x, e, sign)
    123 
    124         If sign Then
     121        Dim e As Long, negative As Boolean
     122        Dim s = FloatToChars(x, e, negative)
     123
     124        If negative Then
    125125            .Append("-")
    126126        Else
    … …  
    151151        End If
    152152
    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)
    171156    End With
    172157    FormatFloatE = sb.ToString()
    … …  
    174159
    175160'! DWordの最大値4294967295の文字数 - 1。FormatIntegerU内で使用。
    176 Const MaxSize = 9
     161Const MaxSizeU = 9
    177162
    178163/*!
    … …  
    187172*/
    188173Function 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)
     175End Function
     176
     177'! Longの最大値2147483647, -2147483648の符号部を除く文字数 - 1。FormatIntegerU内で使用。
     178Const 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*/
     190Function 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)
     207End 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*/
     220Function FormatInteger(x As DWord, d As DWord, field As DWord, flags As FormatFlags, signChar As StrChar) As String
    191221    '左揃えのときまたは精度が指定されているとき、ゼロフラグは無視される。
    192222    If (flags And Left) Or (d <> DWORD_MAX) Then
    … …  
    200230    Dim sb = New System.Text.StringBuilder
    201231    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
    204238        While x <> 0
    205239            buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策
    … …  
    208242        Wend
    209243       
    210         Dim len = (MaxSize - i) As Long
     244        Dim len = (MaxSizeU - i) As Long
    211245        If len < d Then
    212246            .Append(&h30 As StrChar, d - len)
    … …  
    215249        .Append(buf, i + 1, len)
    216250
    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()
     254End Function
     255
     256'! QWordの最大値18446744073709551615の文字数 - 1。FormatIntegerLU内で使用。
     257Const MaxSizeLU = 19
     258
     259/*!
     260@brief 文字列をフィールド幅まで満たされるように空白などを挿入する。
     261@param [in,out] sb 対象文字列
     262@param [in] field フィールド幅
     263@param [in] hasSign 符号を持っている（負の値か）か否か
     264@param [in] flags フラグ
     265*/
     266Sub 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
    219270            If flags And Left Then
    220271                .Append(&h20, embeddedSize)
    221272            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
    223282            End If
    224283        End If
     284
    225285    End With
    226     FormatIntegerU = sb.ToString()
    227 End Function
     286End Sub
    228287
    229288End Namespace 'Detail

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

    r272 r355  
    193193
    194194Namespace Detail
    195 Function Split(s As String, c As StrChar) As /*System.*/ArrayList '暫定
    196     Split = New /*System.*/ArrayList
     195Function Split(s As String, c As StrChar) As System.Collections.ArrayList
     196    Split = New System.Collections.ArrayList
    197197
    198198    Dim last = 0 As Long

  • trunk/Include/Classes/System/Collections/ArrayList.ab

    r309 r355  
    22
    33#require <Classes/System/Collections/misc.ab>
     4
     5Namespace System
     6Namespace Collections
    47
    58Class ArrayList
    … …  
    351354End Class
    352355
    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 */
     356End Namespace 'Collections
     357End Namespace 'System

  • trunk/Include/Classes/System/Collections/misc.ab

    r195 r355  
    33#ifndef __SYSTEM_COLLECTIONS_MISC_AB__
    44#define __SYSTEM_COLLECTIONS_MISC_AB__
     5
     6Namespace System
     7Namespace Collections
    58
    69Interface ICollection
    … …  
    114117End Class
    115118
     119End Namespace 'Collections
     120End Namespace 'System
     121
    116122#endif '__SYSTEM_COLLECTIONS_MISC_AB__

  • trunk/Include/Classes/index.ab

    r353 r355  
    22#require "./ActiveBasic/Core/TypeInfo.ab"
    33#require "./ActiveBasic/Math/Math.ab"
    4 #require "./ActiveBasic/Strings/SPrintF.ab"
     4'#require "./ActiveBasic/Strings/SPrintF.ab"
    55#require "./ActiveBasic/Strings/Strings.ab"
    66#require "./ActiveBasic/Windows/CriticalSection.ab"

  • trunk/Include/basic/function.sbp

    r303 r355  
    10191019End Function
    10201020
     1021/*!
     1022@brief  ABオブジェクトを指すポインタをObject型へ変換。
     1023@author Egtra
     1024@date   2007/08/24
     1025@param[in]  p   COMインタフェースを指すポインタ
     1026@return Object参照型
     1027*/
    10211028Function _System_PtrObj(p As VoidPtr) As Object
    10221029    SetPointer(VarPtr(_System_PtrObj), p)
     1030End 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*/
     1039Function _System_PtrUnknown(p As VoidPtr) As IUnknown
     1040    SetPointer(VarPtr(_System_PtrUnknown), p)
    10231041End Function
    10241042

  • trunk/Include/com/currency.ab

    r335 r355  
    5656        Return ret
    5757    End Function
    58 
     58/*
    5959    Const Function Operator /(y As Variant) As Double
    6060        Dim vx = New Variant(This)
    6161        Dim ret = vx / y
    62         Return ret.ValR4
     62        Return ret.ValR8
    6363    End Function
    6464
    … …  
    6767        Dim vy = New Variant(y)
    6868        Dim ret = vx / vy
    69         Return ret.ValR4
    70     End Function
    71 
     69        Return ret.ValR8
     70    End Function
     71*/
    7272    Const Function Operator +(y As Currency) As Currency
    7373        Dim ret = New Currency

  • trunk/Include/com/decimal.ab

    r335 r355  
    1515    Sub Decimal(d As Decimal)
    1616'       dec = d なぜかコンパイルできない
     17        memcpy(VarPtr(dec), VarPtr(d.dec), Len(dec))
     18    End Sub
     19
     20    Sub Decimal(ByRef d As DECIMAL)
    1721        memcpy(VarPtr(dec), VarPtr(d), Len(dec))
    1822    End Sub
    … …  
    340344
    341345    Const Function ToVariant() As Variant
    342         Return New Variant(dec)
     346        Return New Variant(This)
    343347    End Function
    344348

  • trunk/Include/com/index.ab

    r211 r355  
    33#require <com/bstring.ab>
    44#require <com/variant.ab>
    5 #require <com/vbobject.ab>
     5'#require <com/vbobject.ab>
    66#require <com/currency.ab>
    77#require <com/decimal.ab>

  • trunk/Include/com/variant.ab

    r335 r355  
    66'#require <oaidl.ab>
    77'#require <oleauto.ab>
    8 #require <com/index.ab>
     8'#require <com/index.ab>
    99
    1010Namespace ActiveBasic
    … …  
    109109
    110110    Sub Variant(s As String)
    111         Dim bs As BString(s)
    112         Variant(bs)
     111        ValStr = New BString(s)
    113112    End Sub
    114113
    … …  
    118117    End Sub
    119118
     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
    120125
    121126    Sub ~Variant()
    … …  
    127132        v.vt = VT_EMPTY
    128133    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
    138135    Sub Assign(from As Variant)
    139136        Assign(from.v)
    … …  
    171168*/
    172169    'Operators
    173 
     170/*
    174171    Const Function Operator ^(y As Variant) As Variant
    175172        Dim ret = New Variant
    … …  
    265262        Return ret
    266263    End Function
    267 
     264*/
    268265    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)
    272268    End Function
    273269
    274270    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)
    278273    End Function
    279274
    280275    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)
    294283    End Function
    295284
    … …  
    301290        Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
    302291    End Function
    303 
     292/*
    304293    Const Function Operator ==(y As Variant) As Boolean
    305294        Dim c = Compare(This, y)
    … …  
    338327    End Function
    339328*/
     329/*
    340330    Const Function Operator <=(y As Variant) As Boolean
    341331        Dim c = Compare(This, y)
    … …  
    355345        End If
    356346    End Function
    357 
     347*/
    358348    Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
    359349        Dim ret = New Variant
    … …  
    435425    Const Function ValI1() As SByte
    436426        Dim r = ChangeType(VT_I1)
    437         Return GetByte(VarPtr(r.val)) As SByte
     427        Return GetByte(VarPtr(r.v.val)) As SByte
    438428    End Function
    439429
    … …  
    446436    Const Function ValI2() As Integer
    447437        Dim r = ChangeType(VT_I2)
    448         Return GetWord(VarPtr(r.val)) As Integer
     438        Return GetWord(VarPtr(r.v.val)) As Integer
    449439    End Function
    450440
    … …  
    457447    Const Function ValI4() As Long
    458448        Dim r = ChangeType(VT_I4)
    459         Return GetDWord(VarPtr(r.val)) As Long
     449        Return GetDWord(VarPtr(r.v.val)) As Long
    460450    End Function
    461451
    … …  
    468458    Const Function ValI8() As Int64
    469459        Dim r = ChangeType(VT_I8)
    470         Return GetQWord(VarPtr(r.val)) As Int64
     460        Return GetQWord(VarPtr(r.v.val)) As Int64
    471461    End Function
    472462
    … …  
    479469    Const Function ValR4() As Single
    480470        Dim r = ChangeType(VT_R4)
    481         Return GetSingle(VarPtr(r.val))
     471        Return GetSingle(VarPtr(r.v.val))
    482472    End Function
    483473
    … …  
    490480    Const Function ValR8() As Double
    491481        Dim r = ChangeType(VT_UI8)
    492         Return GetDouble(VarPtr(r.val))
     482        Return GetDouble(VarPtr(r.v.val))
    493483    End Function
    494484
    … …  
    512502    Const Function ValError() As SCODE
    513503        Dim r = ChangeType(VT_ERROR)
    514         Return GetDWord(VarPtr(r.val))
     504        Return GetDWord(VarPtr(r.v.val))
    515505    End Function
    516506
    … …  
    524514        Dim r = ChangeType(VT_CY)
    525515        ValCy = New Currency
    526         ValCy.Cy = GetQWord(VarPtr(r.val))
     516        ValCy.Cy = GetQWord(VarPtr(r.v.val))
    527517    End Function
    528518
    … …  
    561551        v.vt = VT_UNKNOWN
    562552    End Sub
    563 
     553/*
    564554    Const Function ValObject() As VBObject
    565555        Dim r As VARIANT
    … …  
    576566        v.vt = VT_DISPATH
    577567    End Sub
    578 
     568*/
    579569    'ValArray
    580570
    581571    Const Function ValDecimal() As Decimal
    582572        Dim p = VarPtr(v) As *Decimal
    583         Return New Deciaml(p[0])
     573        Return New Deciaml(ByVal p)
    584574    End Function
    585575
    586576    Sub ValDecimal(x As Decimal)
    587577        Clear()
    588         Dim p = VarPtr(v) As *Decimal
     578        Dim p = VarPtr(v) As *DECIMAL
    589579        p[0] = x.Dec
    590580        v.vt = VT_DECIMAL '念の為
    … …  
    599589'       If _System_VariantOptionalParam = Nothing Then
    600590'           'ToDo マルチスレッド対応
    601             _System_VariantOptionalParam = New Variant
    602             _System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
     591            VariantOptionalParam = New Variant
     592            VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
    603593'       End If
    604         Return _System_VariantOptionalParam
     594        Return VariantOptionalParam
    605595    End Function
    606596Private
    … …  
    617607End Class
    618608
    619 'Dim _System_VariantOptionalParam = Nothing As Variant
     609Dim VariantOptionalParam = Nothing As Variant
    620610
    621611/*

  • trunk/Include/com/vbobject.ab

    r335 r355  
    295295    Return CallByName
    296296End Function
    297 
     297/*
    298298Function CreateObject(className As PCWSTR) As VBObject
    299299    Return New VBObject(className, 0, CLSCTX_ALL)
Note: See TracChangeset for help on using the changeset viewer.