Ignore:
Timestamp:
Nov 17, 2007, 9:34:36 AM (17 years ago)
Author:
イグトランス (egtra)
Message:

SPrintf関数の実装

Location:
trunk/Include/Classes/ActiveBasic/Strings
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r365 r383  
    102102    Cap = &h20
    103103
     104    '!BASIC接頭辞。&h, &oなど。
     105    BPrefix = &h40
     106
    104107    /*!
    105108    内部処理用に予約。
    … …  
    114117@date   2007/09/18
    115118@param[in] x    文字列化する浮動小数点数値。
    116 @param[in] d    精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。
     119@param[in] precision    精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。
    117120@param[in] field    フィールド幅。
    118121@param[in] flags    書式フラグ。
    … …  
    121124@todo   他の実装での末尾桁の扱いを調べる（このコードでは何もしていないので切捨となっている）。
    122125*/
    123 Function FormatFloatE(x As Double, d As DWord, field As DWord, flags As FormatFlags) As String
    124     If d = DWORD_MAX Then
    125         d = 6
     126Function FormatFloatE(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String
     127    If precision = DWORD_MAX Then
     128        precision = 6
    126129    End If
    127130
    128131    Dim e As Long, negative As Boolean
    129132    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()
     137End Function
     138
     139/**
     140@brief  FormatFloatEの符号・基数部の出力用。
     141@author Egtra
     142@date   2007/10/27
     143*/
     144Function 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)
    135148
    136149        .Append(s[0])
    137150
    138         If (flags And Alt) Or d > 0 Then
     151        If (flags And Alt) Or precision > 0 Then
    139152            .Append(".")
    140153            Dim outputLen = s.Length - 1
    141             If outputLen >= d Then
    142                 .Append(s, 1, d)
     154            If outputLen >= precision Then
     155                .Append(s, 1, precision)
    143156            Else 'sで用意された桁が指定された精度より少ないとき
    144157                .Append(s, 1, outputLen)
    145                 .Append(&h30 As StrChar, d - outputLen) '足りない桁は0埋め
     158                .Append(&h30 As StrChar, precision - outputLen) '足りない桁は0埋め
    146159            End If
    147160        End If
    148 
     161    End With
     162End Function
     163
     164/**
     165@brief  FormatFloatEの指数部の出力用。
     166@author Egtra
     167@date   2007/10/27
     168*/
     169Sub FormatFloatE_Exponent(buf As System.Text.StringBuilder, e As Long, flags As FormatFlags)
     170    With buf
    149171        If flags And Cap Then
    150172            .Append("E")
    … …  
    152174            .Append("e")
    153175        End If
    154 
    155176        .Append(FormatIntegerD(e, 2, 0, Sign Or Zero))
    156 
    157         AdjustFieldWidth(sb, field, flags)
    158177    End With
    159     FormatFloatE = sb.ToString()
    160 End Function
     178End Sub
    161179
    162180/*!
    … …  
    177195    Dim e As Long, negative As Boolean
    178196    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()
     200End Function
     201
     202/**
     203@author Egtra
     204@date   2007/10/27
     205*/
     206Function 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)
    183210
    184211        Dim intPartLen = e + 1
    … …  
    215242            End If
    216243        End If
    217         AdjustFieldWidth(sb, field, flags)
    218244    End With
    219     FormatFloatF = sb.ToString()
     245End 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*/
     258Function 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()
     282End 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 フラグ
     290flagsでAltが立っているとき、この関数は何もしない。
     291*/
     292Sub 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
     313End 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
     325C99では、末尾の0を取り除いても良いとあるので、
     326このルーチンでは取り除くことにしている。
     327*/
     328Function 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
    220384End Function
    221385
    … …  
    261425*/
    262426Function FormatIntegerU(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String
    263     Return FormatIntegerEx(TraitsIntegerDU, x, d, field, flags And (Not (Sign Or Blank)))
     427    Return FormatIntegerEx(TraitsIntegerU[0], x, d, field, flags And (Not (Sign Or Blank)))
    264428End Function
    265429
    … …  
    270434*/
    271435Function FormatIntegerLU(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String
    272     Return FormatIntegerEx(TraitsIntegerLDU, x, d, field, flags And (Not (Sign Or Blank)))
     436    Return FormatIntegerEx(TraitsIntegerU[1], x, d, field, flags And (Not (Sign Or Blank)))
    273437End Function
    274438
    … …  
    284448*/
    285449Function 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)
    295451End Function
    296452
    … …  
    301457*/
    302458Function 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)
    312460End Function
    313461
    … …  
    316464@date   2007/10/26
    317465*/
    318 Dim TraitsIntegerDU As IntegerConvertTraits
    319 With TraitsIntegerDU
    320     .Convert = AddressOf(IntegerDU_Convert)
    321     .Prefix = AddressOf(IntegerDU_Prefix)
     466Dim TraitsIntegerU[1] As IntegerConvertTraits
     467With TraitsIntegerU[0]
     468    .Convert = AddressOf(IntegerU_Convert)
     469    .Prefix = AddressOf(IntegerU_Prefix)
    322470    .MaxSize = MaxSizeU
    323471End With
    324472
    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)
     473With TraitsIntegerU[1]
     474    .Convert = AddressOf(IntegerLU_Convert)
     475    .Prefix = AddressOf(IntegerU_Prefix)
    333476    .MaxSize = MaxSizeLU
    334477End With
    335478
    336479/*!
     480@author Egtra
     481@date   2007/10/28
     482*/
     483Dim TraitsIntegerD[1] As IntegerConvertTraits
     484With TraitsIntegerD[0]
     485    .Convert = AddressOf(IntegerD_Convert)
     486    .Prefix = AddressOf(IntegerD_Prefix)
     487    .MaxSize = MaxSizeU
     488End With
     489
     490With TraitsIntegerD[1]
     491    .Convert = AddressOf(IntegerLD_Convert)
     492    .Prefix = AddressOf(IntegerD_Prefix)
     493    .MaxSize = MaxSizeLU
     494End With
     495
     496/*!
    337497@brief  負数を表すフラグ。FormatIntegerD, LDからIntegerDU_Prefixまでの内部処理用。
    338498@author Egtra
    … …  
    345505@date   2007/10/26
    346506*/
    347 Function IntegerDU_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord
     507Function IntegerU_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord
    348508    Dim x = xq As DWord
    349509    Dim i = MaxSizeU
    … …  
    357517
    358518/*!
    359 @brief  IntegerDU_ConvertのQWord版
     519@brief  IntegerU_ConvertのQWord版
    360520@author Egtra
    361521@date   2007/10/26
    362522@bug    #117のため、現在Int64の最大値を超える値を正しく処理できない。
    363523*/
    364 Function IntegerLDU_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord
     524Function IntegerLU_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord
    365525    Dim i = MaxSizeLU
    366526    While x <> 0
    … …  
    376536@date   2007/10/26
    377537*/
    378 Function IntegerDU_Prefix(x As QWord, flags As FormatFlags) As String
    379     If flags And Minus Then
    380         IntegerDU_Prefix = "-"
     538Function IntegerU_Prefix(x As QWord, flags As FormatFlags) As String
     539End Function
     540
     541/*!
     542@author Egtra
     543@date   2007/10/28
     544*/
     545Function 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)
     547End Function
     548
     549/*!
     550@brief  IntegerD_ConvertのInt64版
     551@author Egtra
     552@date   2007/10/28
     553*/
     554Function 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)
     556End Function
     557
     558/*!
     559@author Egtra
     560@date   2007/10/28
     561*/
     562Function IntegerD_Prefix(x As QWord, flags As FormatFlags) As String
     563    If (x As Int64) < 0 Then
     564        IntegerD_Prefix = "-"
    381565    ElseIf flags And Sign Then
    382         IntegerDU_Prefix = "+"
     566        IntegerD_Prefix = "+"
    383567    ElseIf flags And Blank Then
    384         IntegerDU_Prefix = " "
     568        IntegerD_Prefix = " "
    385569    End If
    386570End Function
    … …  
    406590@date   2007/10/22
    407591*/
    408 Dim TraitsIntegerO As IntegerConvertTraits
    409 With TraitsIntegerO
     592Dim TraitsIntegerO[1] As IntegerConvertTraits
     593With TraitsIntegerO[0]
    410594    .Convert = AddressOf(IntegerO_Convert)
    411595    .Prefix = AddressOf(IntegerO_Prefix)
    … …  
    413597End With
    414598
    415 /*!
    416 @author Egtra
    417 @date   2007/10/26
    418 */
    419 Dim TraitsIntegerLO As IntegerConvertTraits
    420 With TraitsIntegerLO
     599With TraitsIntegerO[1]
    421600    .Convert = AddressOf(IntegerLO_Convert)
    422601    .Prefix = AddressOf(IntegerO_Prefix)
    … …  
    435614*/
    436615Function 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)
    438617End Function
    439618
    … …  
    444623*/
    445624Function FormatIntegerLO(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String
    446     Return FormatIntegerEx(TraitsIntegerLO, x, d, field, flags)
     625    Return FormatIntegerEx(TraitsIntegerO[1], x, d, field, flags)
    447626End Function
    448627
    … …  
    491670*/
    492671Function 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
    493677End Function
    494678
    … …  
    511695@date   2007/10/24
    512696*/
    513 Dim TraitsIntegerX As IntegerConvertTraits
    514 With TraitsIntegerX
     697Dim TraitsIntegerX[1] As IntegerConvertTraits
     698With TraitsIntegerX[0]
    515699    .Convert = AddressOf(IntegerX_Convert)
    516700    .Prefix = AddressOf(IntegerX_Prefix)
    … …  
    518702End With
    519703
    520 /*!
    521 @author Egtra
    522 @date   2007/10/26
    523 */
    524 Dim TraitsIntegerLX As IntegerConvertTraits
    525 With TraitsIntegerLX
     704With TraitsIntegerX[1]
    526705    .Convert = AddressOf(IntegerLX_Convert)
    527706    .Prefix = AddressOf(IntegerX_Prefix)
    … …  
    540719*/
    541720Function 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)
    543722End Function
    544723
    … …  
    549728*/
    550729Function FormatIntegerLX(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String
    551     Return FormatIntegerEx(TraitsIntegerLX, x, d, field, flags)
     730    Return FormatIntegerEx(TraitsIntegerX[1], x, d, field, flags)
    552731End Function
    553732
    … …  
    587766*/
    588767Function IntegerX_Prefix(x As QWord, flags As FormatFlags) As String
    589     If flags And Alt Then
    590         If x <> 0 Then
     768    If x <> 0 Then
     769        If flags And Alt Then
    591770            IntegerX_Prefix = "0X"
     771        ElseIf flags And BPrefix Then
     772            IntegerX_Prefix = "&H"
    592773        End If
    593774    End If
    … …  
    598779@author Egtra
    599780@date   2007/10/22
     781
     782FormatIntegerの都合上、このファイル内で宣言しているIntegerConvertTraits型の
     783変数は全て配列となっている；[0]が32ビット変換、[1]が64ビット変換である。
    600784*/
    601785Type IntegerConvertTraits
    … …  
    701885End Sub
    702886
     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*/
     897Function 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()
     902End 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*/
     914Function 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()
     919End Function
     920
     921/*!
     922@author Egtra
     923@date   2007/10/28
     924*/
     925TypeDef 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*/
     931Sub 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))
     942End Sub
     943
     944/*!
     945@author Egtra
     946@date   2007/10/28
     947*/
     948Sub 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))
     995End 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*/
     1008Function 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])
     1026End 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*/
     1036Function IsDigit(c As StrChar) As Boolean
     1037    Dim dw = (c As DWord)
     1038    IsDigit = (dw - &h30) < 10
     1039End 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   行わなかった
     1051fmt[0]が*のときにはparamsから1つ読み取る。
     1052そうでなく、fmtに数字（先頭に-符号があっても可）が並んでいれば、それを読み取る。
     1053*/
     1054Function 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
     1070End 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*/
     1081Function 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
     1105End 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*/
     1117Sub 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
     1130End 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*/
     1141Function 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
     1156End Function
     1157
     1158/*!
     1159@biref  長さ指定の読み込み
     1160@author Egtra
     1161@date   2007/10/29
     1162@param[in, out] fmt
     1163@param[out] lengthSpec
     1164*/
     1165Sub 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
     1190End Sub
     1191
     1192/*!
     1193@author Egtra
     1194@date   2007/10/27
     1195@todo   %nへの対応
     1196*/
     1197Function 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
     1272End Function
     1273
    7031274End 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
     1285Function 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)
     1297End 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*/
     1307Function 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)
     1318End 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*/
     1328Function 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)
     1339End 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*/
     1349Function 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)
     1359End 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*/
     1369Function 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)
     1379End 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*/
     1389Function 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)
     1398End 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*/
     1408Function 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)
     1416End 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*/
     1426Function 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)
     1434End 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*/
     1444Function 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)
     1452End 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*/
     1462Function 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)
     1465End 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*/
     1475Function SPrintf(format As String) As String
     1476    SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, 0, 0)
     1477End Function
    7041478
    7051479End Namespace 'Strings

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

    r370 r383  
    1111
    1212Sub ChrFill(p As PWSTR, n As SIZE_T, c As WCHAR)
    13     Dim i As SIZE_T
    14     For i = 0 To ELM(n)
     13    Dim i = 0 As SIZE_T
     14    While i <> n
    1515        p[i] = c
    16     Next
     16        i++
     17    Wend
    1718End Sub
    1819
    1920Sub ChrFill(p As PSTR, n As SIZE_T, c As SByte)
    20     Dim i As SIZE_T
    21     For i = 0 To ELM(n)
     21    Dim i = 0 As SIZE_T
     22    While i <> n
    2223        p[i] = c
    23     Next
     24        i++
     25    Wend
    2426End Sub
    2527
    … …  
    105107
    106108Function ChrPBrk(str As PCWSTR, cStr As SIZE_T, chars As PCWSTR, cChars As SIZE_T) As SIZE_T
    107     Dim i As SIZE_T
    108     For i = 0 To ELM(cStr)
     109    Dim i = 0 As SIZE_T
     110    While i <> cStr
    109111        If ChrFind(chars, cChars, str[i]) <> -1 Then
    110112            Return i
    111113        End If
    112     Next
     114        i++
     115    Wend
    113116    Return -1 As SIZE_T
    114117End Function
    115118
    116119Function ChrPBrk(str As PCSTR, cStr As SIZE_T, Chars As PCSTR, cChars As SIZE_T) As SIZE_T
    117     Dim i As SIZE_T
    118     For i = 0 To ELM(cStr)
     120    Dim i = 0 As SIZE_T
     121    While i <> cStr
    119122        If ChrFind(Chars, cChars, str[i]) <> -1 Then
    120123            Return i
    121124        End If
    122     Next
     125        i++
     126    Wend
    123127    Return -1 As SIZE_T
    124128End Function
    125129
    126130Function ChrFind(s As PCWSTR, size As SIZE_T, c As WCHAR) As SIZE_T
    127     Dim i As SIZE_T
    128     For i = 0 To ELM(size)
     131    Dim i = 0 As SIZE_T
     132    While i <> size
    129133        If s[i] = c Then
    130134            Return i
    131135        End If
    132     Next
     136        i++
     137    Wend
    133138    Return -1 As SIZE_T
    134139End Function
    135140
    136141Function ChrFind(s As PCSTR, size As SIZE_T, c As CHAR) As SIZE_T
    137     Dim i As SIZE_T
    138     For i = 0 To ELM(size)
     142    Dim i = 0 As SIZE_T
     143    While i <> size
    139144        If s[i] = c Then
    140145            Return i
    141146        End If
    142     Next
     147        i++
     148    Wend
    143149    Return -1 As SIZE_T
    144150End Function
    … …  
    210216    Loop
    211217End Function
     218
    212219End Namespace 'Detail
    213220
Note: See TracChangeset for help on using the changeset viewer.