'Classes/ActiveBasic/Strings/SPrintF.ab Namespace ActiveBasic Namespace Strings Namespace Detail /*! @brief 浮動小数点数を文字列化する低水準な関数。符号、指数、仮数に分けて出力。 @author Egtra @date 2007/09/18 @param[in] x 文字列化する浮動小数点数 @param[out] e 指数 @param[out] sign 符号 @return 仮数 仮数は1の位から下へ17桁で、小数点を含まない。そのため、誤差を無視すればVal(仮数) * 10 ^ (e - 17) = Abs(x)が成り立つ。 xに無限大、非数を渡した場合の動作は未定義。 */ Function FloatToChars(x As Double, ByRef e As Long, ByRef sign As Boolean) As String Imports System '0を弾く If x = 0 Then If GetQWord(VarPtr(x) As *QWord) And &h8000000000000000 Then sign = True Else sign = False End If e = 0 FloatToChars = "00000000000000000" Exit Function End If '符号の判断(同時に符号を取り除く) If x < 0 Then sign = True x = -x Else sign = False End If '1e16 <= x < 1e17へ正規化 '(元のx) = (正規化後のx) ^ (d - 17)である。 Dim d = Math.Floor(Math.Log10(x)) As Long If d < 16 Then x *= ipow(10, +17 - d) ElseIf d > 16 Then x /= ipow(10, -17 + d) End If '補正 While x < 1e16 x *= 10 d-- Wend While x >= 1e17 x /= 10 d++ Wend d-- e = d FloatToChars = FormatIntegerLU((x As Int64) As QWord, 17, 0, None) End Function /*! @brief 書式化関数群で使用するフラグ。 @author Egtra @date 2007/09/18 */ Const Enum FormatFlags '! 何も指定がない。 None = &h0 /*! 符号、+。符号付変換[diAaEeFfGg]のとき、正の値でも符号を付ける。 AdjustFieldWidthの仕様から、Format関数郡内からAdjustFieldWidthにかけて、 単に数値が符号付である(負の値である)ことを示す意味でも用いられる。 */ Sign = &h1 /*! 空白、空白文字。 符号付変換[diAaEeFfGg]のとき、正の値ならば符号分の空白を開ける。Signが立っているときには無視される。 */ Blank = &h2 /*! ゼロ、0。 [diouXxAaEeFfGg]で、フィールドの空きを0で埋める。leftが立っているときには無視される。 */ Zero = &h4 '! 左揃え、-。フィールド内で左揃えにする。 Left = &h8 /*! 代替表記、#。
  • [AaEeFfGg]では、精度0でも小数点を付ける。
  • [Gg]では、それに加え、小数部末尾の0の省略を行わないようにする。 */ Alt = &h10 '! 大文字。使用するアルファベットを大文字にする。[aefgx]を[AEFGX]化する。 Cap = &h20 '!BASIC接頭辞。&h, &oなど。 BPrefix = &h40 /*! 内部処理用に予約。 @note Minusとして使用されている。 */ Reserved = &h80000000 End Enum /*! @brief 浮動小数点数をprintfの%e, %E(指数形式、十進法)相当の変換で文字列化する関数。 @author Egtra @date 2007/09/18 @param[in] x 文字列化する浮動小数点数値。 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 @todo 他の実装での末尾桁の扱いを調べる(このコードでは何もしていないので切捨となっている)。 */ Function FormatFloatE(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String If precision = DWORD_MAX Then precision = 6 End If Dim e As Long, negative As Boolean Dim s = FloatToChars(x, e, negative) Dim sb = FormatFloatE_Base(s, negative, precision, flags) FormatFloatE_Exponent(sb, e, flags) AdjustFieldWidth(sb, field, flags) FormatFloatE = sb.ToString() End Function /** @brief FormatFloatEの符号・基数部の出力用。 @author Egtra @date 2007/10/27 */ Function FormatFloatE_Base(s As String, negative As Boolean, precision As DWord, ByRef flags As FormatFlags) As System.Text.StringBuilder FormatFloatE_Base = New System.Text.StringBuilder With FormatFloatE_Base AppendSign(FormatFloatE_Base, negative, flags) .Append(s[0]) If (flags And Alt) Or precision > 0 Then .Append(".") Dim outputLen = s.Length - 1 If outputLen >= precision Then .Append(s, 1, precision) Else 'sで用意された桁が指定された精度より少ないとき .Append(s, 1, outputLen) .Append(&h30 As StrChar, precision - outputLen) '足りない桁は0埋め End If End If End With End Function /** @brief FormatFloatEの指数部の出力用。 @author Egtra @date 2007/10/27 */ Sub FormatFloatE_Exponent(buf As System.Text.StringBuilder, e As Long, flags As FormatFlags) With buf If flags And Cap Then .Append("E") Else .Append("e") End If .Append(FormatIntegerD(e, 2, 0, Sign Or Zero)) End With End Sub /*! @brief 浮動小数点数をprintfの%f(小数形式、十進法)相当の変換で文字列化する関数。 @author Egtra @date 2007/10/23 @param[in] x 文字列化する浮動小数点数値。 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値6となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 */ Function FormatFloatF(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String If precision = DWORD_MAX Then precision = 6 End If Dim e As Long, negative As Boolean Dim s = FloatToChars(x, e, negative) Dim sb = FormatFloatF_Core(s, e, negative, precision, flags) AdjustFieldWidth(sb, field, flags) FormatFloatF = sb.ToString() End Function /** @author Egtra @date 2007/10/27 */ Function FormatFloatF_Core(s As String, e As Long, negative As Boolean, precision As DWord, ByRef flags As FormatFlags) As System.Text.StringBuilder FormatFloatF_Core = New System.Text.StringBuilder With FormatFloatF_Core AppendSign(FormatFloatF_Core, negative, flags) Dim intPartLen = e + 1 Dim outputDigit = 0 As DWord If intPartLen >= 17 Then '有効桁が全て整数部に収まる場合 .Append(s) .Append(&h30 As StrChar, intPartLen - 17) outputDigit = 17 ElseIf intPartLen > 0 Then '有効桁の一部が整数部にかかる場合 .Append(s, 0, intPartLen) outputDigit = intPartLen Else '有効桁が全く整数部にかからない場合 .Append(&h30 As StrChar) End If If precision > 0 Or (flags And Alt) Then .Append(".") Dim lastDigit = s.Length - outputDigit If lastDigit >= precision Then '変換して得られた文字列の桁数が精度以上ある場合 Dim zeroDigit = 0 If intPartLen < 0 Then '1.23e-4 = 0.000123のように指数が負のため小数点以下に0が続く場合 zeroDigit = System.Math.Min(-intPartLen As DWord, precision) .Append(&h30 As StrChar, zeroDigit As Long) End If .Append(s, outputDigit, (precision - zeroDigit) As Long) Else .Append(s, outputDigit, lastDigit) .Append(&h30 As StrChar, (precision - lastDigit) As Long) '残りの桁は0埋め End If End If End With End Function /*! @brief 浮動小数点数をprintfの%g, %G(小数・指数、十進法)相当の変換で文字列化する関数。 @author Egtra @date 2007/10/23 @param[in] x 文字列化する浮動小数点数値。 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXまたは0のとき、指定なしとして既定値6となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 @todo 下位桁の扱いの調査。 */ Function FormatFloatG(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String 'GではE/Fと違い整数部も有効桁数に数えるのでその分を引いておく。 If precision = DWORD_MAX Or precision = 0 Then precision = 5 Else precision-- End If Dim e As Long, negative As Boolean Dim s = FloatToChars(x, e, negative) Dim sb = Nothing As System.Text.StringBuilder If -5 < e And e < precision Then sb = FormatFloatF_Core(s, e, negative, -e + precision, flags) FormatFloatG_RemoveLowDigit(sb, flags) Else sb = FormatFloatE_Base(s, negative, precision, flags) FormatFloatG_RemoveLowDigit(sb, flags) FormatFloatE_Exponent(sb, e, flags) End If AdjustFieldWidth(sb, field, flags) FormatFloatG = sb.ToString() End Function /*! @brief FormatFloatG/A用の小数点以下末尾の0を削除するルーチン @author Egtra @date 2007/10/27 @param[in, out] sb 文字列バッファ @param[in] flags フラグ flagsでAltが立っているとき、この関数は何もしない。 */ Sub FormatFloatG_RemoveLowDigit(sb As System.Text.StringBuilder, flags As FormatFlags) Imports ActiveBasic.Strings Dim count = sb.Length If (flags And Alt) = 0 Then Dim point = ChrFind(StrPtr(sb), count As SIZE_T, Asc(".")) If point = -1 Then Debug End If Dim i As Long For i = count - 1 To point + 1 Step -1 If sb[i] <> &h30 Then Exit For End If Next If i <> point Then i++ End If sb.Length = i End If End Sub /*! @brief 浮動小数点数をprintfの%a, %A(指数形式、十六進法)相当の変換で文字列化する関数。 @author Egtra @date 2007/09/18 @param[in] x 文字列化する浮動小数点数値。 @param[in] precision 精度。小数点以下の桁数。DWORD_MAXのとき、指定なしとして既定値13となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 C99では、末尾の0を取り除いても良いとあるので、 このルーチンでは取り除くことにしている。 */ Function FormatFloatA(x As Double, precision As DWord, field As DWord, flags As FormatFlags) As String If precision = DWORD_MAX Then precision = 13 End If Dim pqw = VarPtr(x) As *QWord Dim sb = New System.Text.StringBuilder With sb Dim sign = (GetQWord(pqw) And &H8000000000000000) As Boolean pqw[0] And= &h7fffffffffffffff AppendSign(sb, sign, flags) If flags And BPrefix Then .Append("&H") Else .Append("0X") End If Dim biasedExp = (GetQWord(pqw) >> 52) As DWord And &h7FF Dim exp As Long If biasedExp = 0 Then If GetQWord(pqw) <> 0 Then exp = -1022 '非正規化数への対応 Else exp = 0 End If .Append("0") Else exp = biasedExp - 1023 .Append("1") End If If precision > 0 Or (flags And Alt) Then .Append(".") Dim base = FormatIntegerLX(GetQWord(pqw) And &h000fffffffffffff, 13, 0, flags And Cap) Dim diff = precision - 13 As Long If diff <= 0 Then .Append(Left$(base, precision)) Else .Append(base).Append(&h30, diff) End If End If FormatFloatG_RemoveLowDigit(sb, flags) .Append("P") .Append(FormatIntegerD(exp, 1, 0, Sign)) FormatFloatA = .ToString() End With If (flags And Cap) = 0 Then FormatFloatA = FormatFloatA.ToLower() End If End Function /*! @brief 先頭に符号もしくはその分の空白を出力する。FormatFloat用。 @author Egtra @date 2007/10/23 @param[in, out] sb 出力先 @param[in] negative 符号 @param[in, out] flags フラグ。negative = Trueなら、Signを立てて返す。 */ Sub AppendSign(sb As System.Text.StringBuilder, negative As Boolean, ByRef flags As FormatFlags) With sb If negative Then .Append("-") flags Or= Sign Else If flags And Sign Then .Append("+") ElseIf flags And Blank Then .Append(" ") End If End If End With End Sub /*! @brief DWordの最大値4294967295の文字数 - 1。FormatIntegerU内で使用。 @author Egtra @date 2007/09/18 */ Const MaxSizeU = 9 /*! @brief 符号無し整数をprintfの%u(十進法表現)相当の変換で文字列化する関数。 @author Egtra @date 2007/09/18 @param[in] x 文字列化する整数値。 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 */ Function FormatIntegerU(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerU[0], x, d, field, flags And (Not (Sign Or Blank))) End Function /*! @brief FormatIntegerUのQWord版 @author Egtra @date 2007/10/26 */ Function FormatIntegerLU(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerU[1], x, d, field, flags And (Not (Sign Or Blank))) End Function /*! @brief 符号有り整数をprintfの%d(十進法表現)相当の変換で文字列化する関数。 @author Egtra @date 2007/10/13 @param[in] x 文字列化する整数値。 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 */ Function FormatIntegerD(x As Long, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerD[0], (x As Int64) As QWord, d, field, flags) End Function /*! @brief FormatIntegerDのInt64版 @author Egtra @date 2007/10/26 */ Function FormatIntegerLD(x As Int64, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerD[1], x As QWord, d, field, flags) End Function /*! @author Egtra @date 2007/10/26 */ Dim TraitsIntegerU[1] As IntegerConvertTraits With TraitsIntegerU[0] .Convert = AddressOf(IntegerU_Convert) .Prefix = AddressOf(IntegerU_Prefix) .MaxSize = MaxSizeU End With With TraitsIntegerU[1] .Convert = AddressOf(IntegerLU_Convert) .Prefix = AddressOf(IntegerU_Prefix) .MaxSize = MaxSizeLU End With /*! @author Egtra @date 2007/10/28 */ Dim TraitsIntegerD[1] As IntegerConvertTraits With TraitsIntegerD[0] .Convert = AddressOf(IntegerD_Convert) .Prefix = AddressOf(IntegerD_Prefix) .MaxSize = MaxSizeU End With With TraitsIntegerD[1] .Convert = AddressOf(IntegerLD_Convert) .Prefix = AddressOf(IntegerD_Prefix) .MaxSize = MaxSizeLU End With /*! @brief 負数を表すフラグ。FormatIntegerD, LDからIntegerDU_Prefixまでの内部処理用。 @author Egtra @date 2007/10/26 */ Const Minus = Reserved /*! @author Egtra @date 2007/10/26 */ Function IntegerU_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord Dim x = xq As DWord Dim i = MaxSizeU While x <> 0 buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策 x \= 10 i-- Wend Return i End Function /*! @brief IntegerU_ConvertのQWord版 @author Egtra @date 2007/10/26 @bug #117のため、現在Int64の最大値を超える値を正しく処理できない。 */ Function IntegerLU_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord Dim i = MaxSizeLU While x <> 0 buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策 x \= 10 i-- Wend Return i End Function /*! @author Egtra @date 2007/10/26 */ Function IntegerU_Prefix(x As QWord, flags As FormatFlags) As String End Function /*! @author Egtra @date 2007/10/28 */ Function IntegerD_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord Return IntegerU_Convert(buf, Abs((xq As DWord) As Long) As DWord, flags) End Function /*! @brief IntegerD_ConvertのInt64版 @author Egtra @date 2007/10/28 */ Function IntegerLD_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord Return IntegerLU_Convert(buf, Abs(x As Int64) As QWord, flags) End Function /*! @author Egtra @date 2007/10/28 */ Function IntegerD_Prefix(x As QWord, flags As FormatFlags) As String If (x As Int64) < 0 Then IntegerD_Prefix = "-" ElseIf flags And Sign Then IntegerD_Prefix = "+" ElseIf flags And Blank Then IntegerD_Prefix = " " End If End Function /*! @brief DWordの最大値の八進法表現37777777777の文字数 - 1 + 1。IntegerO_Convert内で使用。 @author Egtra @date 2007/10/19 上の式で1を加えているのは、八進接頭辞の分。 */ Const MaxSizeO = 11 /*! @brief QWordの最大値の八進法表現1777777777777777777777の文字数 - 1 + 1。IntegerO_Convert内で使用。 @author Egtra @date 2007/10/26 上の式で1を加えているのは、八進接頭辞の分。 */ Const MaxSizeLO = 22 /*! @author Egtra @date 2007/10/22 */ Dim TraitsIntegerO[1] As IntegerConvertTraits With TraitsIntegerO[0] .Convert = AddressOf(IntegerO_Convert) .Prefix = AddressOf(IntegerO_Prefix) .MaxSize = MaxSizeO End With With TraitsIntegerO[1] .Convert = AddressOf(IntegerLO_Convert) .Prefix = AddressOf(IntegerO_Prefix) .MaxSize = MaxSizeLO End With /*! @brief 符号無し整数をprintfの%o(八進法表現)相当の変換で文字列化する関数。 @author Egtra @date 2007/10/19 @param[in] x 文字列化する整数値。 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 */ Function FormatIntegerO(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerO[0], x, d, field, flags) End Function /*! @brief FormatIntegerOのQWord版。 @author Egtra @date 2007/10/26 */ Function FormatIntegerLO(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerO[1], x, d, field, flags) End Function /*! @author Egtra @date 2007/10/22 */ Function IntegerO_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord Dim x = xq As DWord Dim i = MaxSizeO While x <> 0 buf[i] = ((x And &o7) + &h30) As StrChar x >>= 3 i-- Wend If flags And Alt Then buf[i] = &h30 i-- End If Return i End Function /*! @brief IntegerO_ConvertのQWord版。 @author Egtra @date 2007/10/26 */ Function IntegerLO_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord Dim i = MaxSizeLO While x <> 0 buf[i] = ((x And &o7) + &h30) As StrChar x >>= 3 i-- Wend If flags And Alt Then buf[i] = &h30 i-- End If Return i End Function /*! @author Egtra @date 2007/10/22 @note #フラグ (Alt)の処理は、IntegerO/LO_Convert内で行うので、ここで処理することはない。 */ Function IntegerO_Prefix(x As QWord, flags As FormatFlags) As String If flags And BPrefix Then If x <> 0 Then IntegerO_Prefix = "&O" End If End If End Function /*! @brief DWordの最大値の十六進法表現ffffffffの文字数 - 1。FormatIntegerO内で使用。 @author Egtra @date 2007/10/24 */ Const MaxSizeX = 7 /*! @brief QWordの最大値の十六進法表現ffffffffffffffffの文字数 - 1。FormatIntegerO内で使用。 @author Egtra @date 2007/10/26 */ Const MaxSizeLX = 15 /*! @author Egtra @date 2007/10/24 */ Dim TraitsIntegerX[1] As IntegerConvertTraits With TraitsIntegerX[0] .Convert = AddressOf(IntegerX_Convert) .Prefix = AddressOf(IntegerX_Prefix) .MaxSize = MaxSizeX End With With TraitsIntegerX[1] .Convert = AddressOf(IntegerLX_Convert) .Prefix = AddressOf(IntegerX_Prefix) .MaxSize = MaxSizeLX End With /*! @brief 整数をprintfの%x, %X(十六進法)相当の変換で文字列化する関数。 @author Egtra @date 2007/10/19 @param[in] x 文字列化する整数値。 @param[in] d 精度、最小限表示される桁数。DWORD_MAXのとき、指定なしとして、既定値1となる。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return xの文字列表現 */ Function FormatIntegerX(x As DWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerX[0], x, d, field, flags) End Function /*! @brief FormatIntegerXのQWord版。 @author Egtra @date 2007/10/22 */ Function FormatIntegerLX(x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String Return FormatIntegerEx(TraitsIntegerX[1], x, d, field, flags) End Function /*! @author Egtra @date 2007/10/22 */ Function IntegerX_Convert(buf As *StrChar, xq As QWord, flags As FormatFlags) As DWord Dim i = MaxSizeX Dim x = xq As DWord While x <> 0 buf[i] = _System_HexadecimalTable[x And &h0f] x >>= 4 i-- Wend Return i End Function /*! @brief IntegerX_ConvertのQWord版。 @author Egtra @date 2007/10/22 */ Function IntegerLX_Convert(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord Dim i = MaxSizeLX While x <> 0 buf[i] = _System_HexadecimalTable[x And &h0f] x >>= 4 i-- Wend Return i End Function /*! @author Egtra @date 2007/10/24 */ Function IntegerX_Prefix(x As QWord, flags As FormatFlags) As String If x <> 0 Then If flags And Alt Then IntegerX_Prefix = "0X" ElseIf flags And BPrefix Then IntegerX_Prefix = "&H" End If End If End Function /*! @brief FormatIntegerExへ渡す変換特性を表す構造体型。 @author Egtra @date 2007/10/22 FormatIntegerの都合上、このファイル内で宣言しているIntegerConvertTraits型の 変数は全て配列となっている;[0]が32ビット変換、[1]が64ビット変換である。 */ Type IntegerConvertTraits '!変換を行う関数へのポインタ。 Convert As *Function(buf As *StrChar, x As QWord, flags As FormatFlags) As DWord '!接頭辞を取得する関数へのポインタ。 Prefix As *Function(x As QWord, flags As FormatFlags) As String '!必要なバッファの大きさ。 MaxSize As DWord End Type /*! @brief 整数変換全てを行う関数。これを雛形とし、形式毎の差異はIntegerConvertTraitsで表現する。 @author Egtra @date 2007/10/22 @param[in] tr 特性情報。 @param[in] x 変換元の数値。 @param[in] d 精度。ここでは最低限出力する桁数。 @param[in] field フィールド幅。 @param[in] flags フラグ。 */ Function FormatIntegerEx(ByRef tr As IntegerConvertTraits, x As QWord, d As DWord, field As DWord, flags As FormatFlags) As String If d = DWORD_MAX Then d = 1 Else '精度が指定されているとき、ゼロフラグは無視される。 '仕様上、左揃えのときも無視されるが、それはAdjustFieldWidthが行ってくれる。 flags And= Not Zero End If Dim sb = New System.Text.StringBuilder With sb Dim prefixFunc = tr.Prefix Dim prefix = prefixFunc(x, flags) sb.Append(prefix) Dim prefixLen = 0 As DWord If String.IsNullOrEmpty(prefix) = False Then prefixLen = prefix.Length As DWord End If Dim buf = GC_malloc_atomic((tr.MaxSize + 1) * SizeOf (StrChar)) As *StrChar Dim convertFunc = tr.Convert Dim bufStartPos = convertFunc(buf, x, flags) Dim len = (tr.MaxSize - bufStartPos) As Long If len < 0 Then Debug End If If len < d Then .Append(&h30 As StrChar, d - len) End If .Append(buf, bufStartPos + 1, len) AdjustFieldWidth(sb, field, flags And (Not (Sign Or Blank)), prefixLen) End With FormatIntegerEx = sb.ToString() If (flags And Cap) = 0 Then FormatIntegerEx = FormatIntegerEx.ToLower() End If End Function /*! @brief QWordの最大値18446744073709551615の文字数 - 1。FormatIntegerLU内で使用。 @author Egtra @date 2007/09/18 */ Const MaxSizeLU = 19 /*! @brief 文字列をフィールド幅まで満たされるように空白などを挿入する。 @author Egtra @date 2007/10/13 @param[in,out] sb 対象文字列 @param[in] field フィールド幅 @param[in] hasSign 符号を持っている(負の値か)か否か @param[in] flags フラグ @param[in] prefixLen (あれば)接頭辞の文字数。ゼロ埋めする際、この数だけ挿入位置を後ろにする。 sbが"-1"のように負符号を持っている場合は、呼出元でSignフラグ(またはBlank)を立てること。 */ Sub AdjustFieldWidth(sb As System.Text.StringBuilder, field As DWord, flags As FormatFlags, prefixLen = 0 As DWord) With sb If .Length < field Then Dim embeddedSize = field - .Length If flags And Left Then .Append(&h20, embeddedSize) Else Dim insPos As Long If (flags And Zero) <> 0 Then If (flags And Blank) Or (flags And Sign) Then insPos++ End If insPos += prefixLen .Insert(insPos, String$(embeddedSize, "0")) Else .Insert(insPos, String$(embeddedSize, " ")) End If End If End If End With End Sub /*! @brief 文字列をprintfの%s相当の変換で書式化する関数。 @author Egtra @date 2007/10/27 @param[in] x 文字列。 @param[in] d 精度、最大の文字数。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return 書式化された文字列。 */ Function FormatString(x As String, d As DWord, field As DWord, flags As FormatFlags) As String Dim sb = New System.Text.StringBuilder( x, 0, System.Math.Min(x.Length As DWord, d) As Long, field) AdjustFieldWidth(sb, field, flags And Left) FormatString = sb.ToString() End Function /*! @brief 文字をprintfの%c相当の変換で書式化する関数。 @author Egtra @date 2007/10/27 @param[in] x 文字。 @param[in] d 精度、最大の文字数。 @param[in] field フィールド幅。 @param[in] flags 書式フラグ。 @return 書式化された文字列。 */ Function FormatCharacter(x As StrChar, d As DWord, field As DWord, flags As FormatFlags) As String Dim sb = New System.Text.StringBuilder(field + 1) sb.Append(x) AdjustFieldWidth(sb, field, flags And Left) FormatCharacter = sb.ToString() End Function /*! @author Egtra @date 2007/10/28 */ TypeDef FormatFloatProc = *Function(x As Double, precision As DWord, fieldWidth As DWord, flags As FormatFlags) As String /*! @author Egtra @date 2007/10/28 */ Sub FormatFloat(s As System.Text.StringBuilder, formatProc As FormatFloatProc, param As Object, precision As DWord, field As DWord, flags As FormatFlags) Dim x As Double Dim typeName = param.GetType().FullName If typeName = "System.Double" Then x = param As System.Double ElseIf typeName = "System.Single" Then x = param As System.Single End If s.Append(formatProc(x, precision, field, flags)) End Sub /*! @author Egtra @date 2007/10/28 */ Sub FormatInteger(s As System.Text.StringBuilder, traits As *IntegerConvertTraits, param As Object, signed As Boolean, typeWidth As Long, precision As DWord, field As DWord, flags As FormatFlags) Dim x As QWord Dim typeName = param.GetType().FullName If typeName = "System.UInt64" Then x = param As System.UInt64 ElseIf typeName = "System.Int64" Then x = (param As System.Int64) As QWord ElseIf typeName = "System.UInt32" Then x = param As System.UInt32 ElseIf typeName = "System.Int32" Then x = (param As System.Int32) As QWord ElseIf typeName = "System.UInt16" Then x = param As System.UInt16 ElseIf typeName = "System.Int16" Then x = (param As System.Int16) As QWord ElseIf typeName = "System.UInt8" Then x = param As System.Byte ElseIf typeName = "System.Int8" Then x = (param As System.SByte) As QWord End If '一旦縮めた後、符号・ゼロ拡張させる。 'また、64ビット整数なら64ビット変換Traitsを選択する。 If signed Then If typeWidth = 1 Then traits = VarPtr(traits[1]) ElseIf typeWidth = 0 Then x = (((x As DWord) As Long) As Int64) As QWord ElseIf typeWidth = -1 Then x = (((x As Word) As Integer) As Int64) As QWord ElseIf typeWidth = -2 Then x = (((x As Byte) As SByte) As Int64) As QWord End If Else If typeWidth = 1 Then traits = VarPtr(traits[1]) ElseIf typeWidth = 0 Then x = x As DWord ElseIf typeWidth = -1 Then x = x As Word ElseIf typeWidth = -2 Then x = x As Byte End If End If s.Append(FormatIntegerEx(ByVal traits, x, precision, field, flags)) End Sub 'Format関数群ここまで '---- /*! @brief 文字列から数値への変換。さらに変換に使われなかった文字列の位置を返す。 @author Egtra @date 2007/11/11 @param[in] s 変換する文字 @param[out] p 変換に使われなかった部分の先頭を指すポインタ @return 変換して得られた数値。変換できなければ0。 */ Function StrToLong(s As *StrChar, ByRef p As *StrChar) As Long Dim negative As Boolean Dim i = 0 As Long If s[i] = &h2d Then 'Asc("-") i++ negative = True End If Do Dim c = s[i] If Not IsDigit(c) Then Exit Do StrToLong *= 10 StrToLong += ((c As DWord) And &h0f) As Long i++ Loop If negative Then StrToLong = -StrToLong End If p = VarPtr(s[i]) End Function /*! @brief 文字が十進数字かどうか調べる。 @author Egtra @date 2007/11/11 @param[in] c 調べる文字 @retval True 0から9の文字である @retval False そうでない */ Function IsDigit(c As StrChar) As Boolean Dim dw = (c As DWord) IsDigit = (dw - &h30) < 10 End Function /*! @brief フィールド幅、精度用の数値読取 @author Egtra @date 2007/11/11 @param[in, out] fmt 読み途中の書式指定 @param[in] params @param[in, out] paramsCount @param[out] ret 読み取った数値。読み取られなかったときの値は不定。 @retval True 読取を行った @retval False 行わなかった fmt[0]が*のときにはparamsから1つ読み取る。 そうでなく、fmtに数字(先頭に-符号があっても可)が並んでいれば、それを読み取る。 */ Function ReadInt(ByRef fmt As *StrChar, params As *Object, ByRef paramsCount As SIZE_T, ByRef ret As Long) As Boolean If fmt[0] = &h2a Then '* fmt++ 'p ret = params[paramsCount] As System.Int32 paramsCount++ ReadInt = True Else Dim p As PSTR ret = StrToLong(fmt, p) If fmt <> p Then fmt = p ReadInt = True Else ReadInt = False End If End If End Function /*! @brief フラグ指定の読み込み @author Egtra @date 2007/10/28 @param[in, out] fmt @param[out] flags @retval True 読み込みが完了した。 @retval False 読み取り中に文字列が終了した(ヌル文字が現れた)。 */ Function ReadFlags(ByRef fmt As *StrChar, ByRef flags As FormatFlags) As Boolean ReadFlags = False Do Select Case fmt[0] Case &h23 '# flags Or= Alt Case &h30 '0 flags Or= Zero Case &h20 '空白 flags Or= Blank Case &h2b '+ flags Or= Sign Case &h2d '- flags Or = Left Case &h26 '& flags Or= BPrefix Case 0 Exit Function Case Else Exit Do End Select fmt++ 'p Loop ReadFlags = True End Function /*! @brief フィールド幅指定の読み込み @author Egtra @date 2007/10/29 @param[in, out] fmt @param[in] params @param[in, out] paramsCount @param[out] fieldWidth @param[in, out] flags */ Sub ReadFieldWidth(ByRef fmt As *StrChar, params As *Object, ByRef paramsCount As SIZE_T, ByRef fieldWidth As DWord, ByRef flags As FormatFlags) Dim t As Long If ReadInt(fmt, params, paramsCount, t) Then If t < 0 Then flags Or= Left fieldWidth = -t As DWord Else fieldWidth = t As DWord End If Else fieldWidth = 0 End If End Sub /*! @brief 精度の読み込み @author Egtra @date 2007/10/29 @param[in, out] fmt @param[in] params @param[in, out] paramsCount @return 読み取った精度。指定がなかったときには、DWORD_MAX。 */ Function ReadPrecision(ByRef fmt As *StrChar, params As *Object, ByRef paramsCount As SIZE_T) As DWord If fmt[0] = &h2e Then '. fmt++ Dim t As Long ReadPrecision = 0 If ReadInt(fmt, params, paramsCount, t) Then If t > 0 Then ReadPrecision = t As DWord End If End If Else ReadPrecision = DWORD_MAX End If End Function /*! @biref 長さ指定の読み込み @author Egtra @date 2007/10/29 @param[in, out] fmt @param[out] lengthSpec */ Sub ReadLength(ByRef fmt As *StrChar, ByRef lengthSpec As Long) Do Select Case fmt[0] Case &h6c 'l lengthSpec++ Case &h68 'h lengthSpec-- Case &h6a 'j (u)intmax_t lengthSpec = 1 #ifdef _WIN64 Case &h74 't ptrdiff_t lengthSpec = 1 Case &h7a 'z (s)size_t, lengthSpec = 1 #else Case &h74 't ptrdiff_t lengthSpec = 0 Case &h7a 'z (s)size_t, lengthSpec = 0 #endif Case Else Exit Sub End Select fmt++ 'p Loop End Sub /*! @author Egtra @date 2007/10/27 @todo %nへの対応 */ Function SPrintf(format As String, params As *Object, n As SIZE_T) As String Dim i = 0 As DWord Dim paramsCount = 0 As SIZE_T Dim fmt = StrPtr(format) Dim s = New System.Text.StringBuilder Do Dim last = format.Length - (fmt - StrPtr(format)) As Long 'p Dim pos = ActiveBasic.Strings.ChrFind(fmt, last, &h25 As StrChar) '&h25 = % If pos = -1 Then s.Append(fmt, 0, last) Exit Do End If '%以前の部分 s.Append(fmt, 0, pos) fmt += pos + 1 'p 'フラグの読取 Dim flags = None As FormatFlags If ReadFlags(fmt, flags) = False Then Exit Do End If 'フィールド幅 Dim fieldWidth As DWord ReadFieldWidth(fmt, params, i, fieldWidth, flags) '精度 Dim precision = ReadPrecision(fmt, params, i) '幅指定の読取 Dim typeWidth As Long ReadLength(fmt, typeWidth) Select Case fmt[0] Case &h64 'd FormatInteger(s, TraitsIntegerD, params[i], True, typeWidth, precision, fieldWidth, flags) Case &h69 'i FormatInteger(s, TraitsIntegerD, params[i], True, typeWidth, precision, fieldWidth, flags) Case &h75 'u FormatInteger(s, TraitsIntegerU, params[i], False, typeWidth, precision, fieldWidth, flags) Case &h6f 'o FormatInteger(s, TraitsIntegerO, params[i], False, typeWidth, precision, fieldWidth, flags) Case &h4f 'O FormatInteger(s, TraitsIntegerO, params[i], False, typeWidth, precision, fieldWidth, flags Or Cap) Case &h78 'x FormatInteger(s, TraitsIntegerX, params[i], False, typeWidth, precision, fieldWidth, flags) Case &h58 'X FormatInteger(s, TraitsIntegerX, params[i], False, typeWidth, precision, fieldWidth, flags Or Cap) Case &h65 'e FormatFloat(s, AddressOf(FormatFloatE), params[i], precision, fieldWidth, flags) Case &h45 'E FormatFloat(s, AddressOf(FormatFloatE), params[i], precision, fieldWidth, flags Or Cap) Case &h66 'f FormatFloat(s, AddressOf(FormatFloatF), params[i], precision, fieldWidth, flags) Case &h46 'F FormatFloat(s, AddressOf(FormatFloatF), params[i], precision, fieldWidth, flags Or Cap) Case &h67 'g FormatFloat(s, AddressOf(FormatFloatG), params[i], precision, fieldWidth, flags) Case &h47 'G FormatFloat(s, AddressOf(FormatFloatG), params[i], precision, fieldWidth, flags Or Cap) Case &h61 'a FormatFloat(s, AddressOf(FormatFloatA), params[i], precision, fieldWidth, flags) Case &h41 'A FormatFloat(s, AddressOf(FormatFloatA), params[i], precision, fieldWidth, flags Or Cap) Case &h73 's s.Append(FormatString(params[i] As String, precision, fieldWidth, flags)) Case &h63 'c s.Append(FormatCharacter(params[i] As BoxedStrChar, precision, fieldWidth, flags)) ' Case &h6e 'n Case &h25 '% s.Append(&h25 As StrChar) i-- Case 0 Exit Do End Select fmt++ 'p i++ Loop SPrintf = s.ToString End Function End Namespace 'Detail /*! @brief Cのsprintfのような書式化関数10引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object, param5 As Object, param6 As Object, param7 As Object, param8 As Object, param9 As Object) As String #ifdef _WIN64 'コンパイラがどういうコードを吐くのかわからないので、安全策を取る。 Dim params[9] = [param0, param1, param2, param3, param4, param5, param6, param7, param8, param9] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 10) End Function /*! @brief Cのsprintfのような書式化関数9引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object, param5 As Object, param6 As Object, param7 As Object, param8 As Object) As String #ifdef _WIN64 Dim params[8] = [param0, param1, param2, param3, param4, param5, param6, param7, param8] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 9) End Function /*! @brief Cのsprintfのような書式化関数8引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object, param5 As Object, param6 As Object, param7 As Object) As String #ifdef _WIN64 Dim params[7] = [param0, param1, param2, param3, param4, param5, param6, param7] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 8) End Function /*! @brief Cのsprintfのような書式化関数7引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object, param5 As Object, param6 As Object) As String #ifdef _WIN64 Dim params[6] = [param0, param1, param2, param3, param4, param5, param6] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 7) End Function /*! @brief Cのsprintfのような書式化関数6引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object, param5 As Object) As String #ifdef _WIN64 Dim params[5] = [param0, param1, param2, param3, param4, param5] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 6) End Function /*! @brief Cのsprintfのような書式化関数5引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object, param4 As Object) As String #ifdef _WIN64 Dim params[4] = [param0, param1, param2, param3, param4] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 5) End Function /*! @brief Cのsprintfのような書式化関数4引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object, param3 As Object) As String #ifdef _WIN64 Dim params[3] = [param0, param1, param2, param3] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 4) End Function /*! @brief Cのsprintfのような書式化関数3引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object, param2 As Object) As String #ifdef _WIN64 Dim params[2] = [param0, param1, param2] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 3) End Function /*! @brief Cのsprintfのような書式化関数2引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object, param1 As Object) As String #ifdef _WIN64 Dim params[1] = [param0, param1] As Object #else Dim params = VarPtr(param0) As *Object #endif SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 2) End Function /*! @brief Cのsprintfのような書式化関数1引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String, param0 As Object) As String Dim params = VarPtr(param0) As *Object SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, params, 1) End Function /*! @brief Cのsprintfのような書式化関数0引数版 @author Egtra @date 2007/10/27 @param[in] format 書式指定 @param[in] paramN 引数 @return 書式化された文字列 */ Function SPrintf(format As String) As String SPrintf = ActiveBasic.Strings.Detail.SPrintf(format, 0, 0) End Function End Namespace 'Strings End Namespace 'ActiveBasic