在 VB6 中实现 String.Format()

本文介绍了在 VB6 中实现 String.Format()的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 String.Format() 能否在 VB6 中实现，至少是它的一个足够接近的版本，以便在好的 VB6 中编程时有用?关于 VB6 字符串操作性能问题的好资源:http://www.aivosto.com/vbtips/stringopt2.html在一个相关的 not，我还想出了几个字符串比较函数，找到它们 在 CodeReview.SE 上这些函数对于提高 VB6 的可读性非常有用，特别是如果您最近被 .net 代码宠坏了，突然需要深入研究 VB6 代码库......享受吧！ 解决方案我在任何地方都找不到，所以我自己做了一个:公共 PADDING_CHAR 作为字符串Public Function StringFormat(format_string As String, ParamArray values()) As String'.net String.Format() 的 VB6 实现，稍微定制.'使用 Office 2010 VBA (x64) 测试Dim return_value As StringDim values_count 作为整数'一些错误处理常量:Const ERR_FORMAT_EXCEPTION As Long = vbObjectError 或 9001Const ERR_ARGUMENT_NULL_EXCEPTION As Long = vbObjectError 或 9002Const ERR_SOURCE As String = "StringFormat"Const ERR_MSG_INVALID_FORMAT_STRING As String = "无效的格式字符串."" Const ERR_MSG_FORMAT_EXCEPTION As String = "表示格式参数的数字小于零，或大于或等于 args 数组的长度.'使用空格作为默认填充字符如果 PADDING_CHAR = vbNullString 那么 PADDING_CHAR = Chr$(32)'找出传递值的数量:values_count = UBound(values) + 1Dim regex As RegExpDim 匹配 As MatchCollection将此匹配调暗为匹配将 thisString 调暗为字符串将此格式调暗为字符串'当 format_string 以 "@" 开头时，不会替换转义符'(字符串被视为带有占位符的文字字符串)Dim useLiteral As BooleanDim escapeHex As Boolean '指示是否要转义十六进制说明符0x"'验证字符串格式:设置正则表达式 = 新正则表达式regex.Pattern = "{({{)*(\w+)(,-?\d+)?(:[^}]+)?}(}})*"regex.IgnoreCase = Trueregex.Global = True设置匹配 = regex.Execute(format_string)'确定 values_count 是否匹配唯一正则表达式匹配的数量:将 uniqueCount 调暗为整数Dim tmpCSV As String对于每个 thisMatch In 匹配项如果不是 StringContains(tmpCSV, thisMatch.SubMatches(1)) 然后uniqueCount = uniqueCount + 1tmpCSV = tmpCSV &thisMatch.SubMatches(1) &，"万一下一个'唯一索引计数必须与 values_count 匹配:如果匹配.计数>0 和 uniqueCount <>values_count 然后 _Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_FORMAT_EXCEPTIONuseLiteral = StringStartsWith("@", format_string)'删除@"文字说明符If useLiteral Then format_string = Right(format_string, Len(format_string) - 1)如果不是 useLiteral 和 StringContains(format_string, "\\") 然后 _format_string = Replace(format_string, "\\", Chr$(27))如果 StringContains(format_string, "\\") 然后 _format_string = Replace(format_string, "\\", Chr$(27))如果matches.Count = 0 And format_string <>vbNullString 和 UBound(values) = -1 然后'只指定了 format_string:跳到检查转义序列:返回值 = 格式字符串转到检查转义ElseIf UBound(values) = -1 并且matches.Count >0 那么Err.Raise ERR_ARGUMENT_NULL_EXCEPTION, _ERR_SOURCE、ERR_MSG_FORMAT_EXCEPTION万一返回值 = 格式字符串'剖析format_string:Dim i As Integer, v As String, p As String 'i: iterator;v:价值；p:占位符将对齐组调暗为字符串，对齐说明符为字符串Dim formattedValue As String，alignmentPadding As Integer'迭代正则表达式匹配(每个匹配是一个占位符):对于 i = 0 匹配.计数 - 1'获取占位符指定的索引:设置 thisMatch = 匹配(i)p = thisMatch.SubMatches(1)'如果指定索引(从 0 开始)>uniqueCount(基于 1)，出了点问题:如果 p >uniqueCount - 1 然后 _Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_FORMAT_EXCEPTIONv = 值(p)'如果指定，则获取对齐说明符:对齐组 = thisMatch.SubMatches(2)如果alignmentGroupvbNullString 然后 _alignmentSpecifier = Right$(alignmentGroup, LenB(alignmentGroup)/2 - 1)'如果指定，则获取格式说明符:thisString = thisMatch.Value如果 StringContains(thisString, ":") 那么Dim formatGroup As String，precisionSpecifier As IntegerDim formatSpecifier As String, precisionString As String'获取 ":" 和 "}" 之间的字符串:formatGroup = Mid$(thisString, InStr(1, thisString, ":") + 1, (LenB(thisString)/2) - 2)formatGroup = Left$(formatGroup, LenB(formatGroup)/2 - 1)precisionString = Right$(formatGroup, LenB(formatGroup)/2 - 1)formatSpecifier = Mid$(thisString, InStr(1, thisString, ":") + 1, 1)'适用的格式取决于值的类型(是的，转到！！):If TypeName(values(p)) = "Date" Then GoTo DateTimeFormatSpecifiers如果 v = vbNullString 然后转到 ApplyStringFormat数字格式说明符:如果 precisionString vbNullString And Not IsNumeric(precisionString) 然后 _Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_INVALID_FORMAT_STRING如果 precisionString = vbNullString 那么 precisionString = 0选择大小写格式说明符Case "C", "c" 'CURRENCY 格式，将字符串格式化为货币.'精度说明符确定小数位数.'这个实现忽略了区域设置'(硬编码的组分隔符、小数分隔符和货币符号).precisionSpecifier = CInt(precisionString)thisFormat = "#,##0.$"如果 LenB(formatGroup) >2 和 precisionSpecifier >0 那么'如果指定了非零精度...此格式 = _替换 $(thisFormat, ".", "." & String$(precisionString, Chr$(48)))万一Case "D", "d" 'DECIMAL 格式，将字符串格式化为整数.'精度说明符确定返回字符串中的位数.precisionSpecifier = CInt(precisionString)thisFormat = "0"thisFormat = Right$(String$(precisionSpecifier, "0") & thisFormat, _IIf(precisionSpecifier = 0, Len(thisFormat), precisionSpecifier))Case "E", "e" 'EXPONENTIAL NOTATION 格式(又名科学记数法")'精度说明符确定返回字符串中的小数位数.'此实现忽略区域设置''(硬编码的十进制分隔符).precisionSpecifier = CInt(precisionString)thisFormat = "0.00000#" &格式说明符"-#" '默认为 6 位小数如果 LenB(formatGroup) >2 和 precisionSpecifier >0 那么'如果指定了非零精度...thisFormat = "0"&String$(precisionSpecifier - 1, Chr$(48)) &#" &格式说明符-#"ElseIf LenB(formatGroup) >2 和 precisionSpecifier = 0 然后Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_INVALID_FORMAT_STRING万一Case "F", "f" 'FIXED-POINT 格式'精度说明符确定返回字符串中的小数位数.'此实现忽略区域设置''(硬编码的十进制分隔符).precisionSpecifier = CInt(precisionString)thisFormat = "0"如果 LenB(formatGroup) >2 和 precisionSpecifier >0 那么'如果指定了非零精度...thisFormat = (thisFormat & ".") &String$(precisionSpecifier, Chr$(48))别的'未指定精度 - 默认为 2 位小数:thisFormat = "0.00"万一Case "G", "g" '通用格式(递归)'在 Double 的情况下返回 FIXED-POINT 或 SCIENTIFIC 格式中最短的.'在整数或长整数的情况下返回 DECIMAL 格式.Dim eNotation As String, ePower As Integer, specifier As StringprecisionSpecifier = IIf(CInt(precisionString) > 0, CInt(precisionString), _IIf(StringContains(v, "."), Len(v) - InStr(1, v, "."), 0))'跟踪格式说明符的字符大小写:说明符 = IIf(formatSpecifier = "G", "D", "d")If TypeName(values(p)) = "Integer" Or TypeName(values(p)) = "Long" Then'整数类型:使用 {0:D}(递归调用):formattedValue = StringFormat("{0:" & 说明符 & "}", values(p))ElseIf TypeName(values(p)) = "Double" Then'非整数类型:使用 {0:E}说明符 = IIf(formatSpecifier = "G", "E", "e")'评估指数符号值(递归调用):eNotation = StringFormat("{0:" & 说明符 & "}", v)'获得 eNotation 的强大功能:ePower = Mid$(eNotation, InStr(1, UCase$(eNotation), "E-") + 1, Len(eNotation) - InStr(1, UCase$(eNotation), "E-"))如果 ePower >-5 和 Abs(ePower) 时使用 {0:F}-5 和 abs(ePower) 2 和 precisionSpecifier >0 那么'如果指定了非零精度...thisFormat = "#,##0"thisFormat = (thisFormat & ".") &String$(precisionSpecifier, Chr$(48))否则 '仅指定了D"thisFormat = "#,##0"万一Case "P", "p" 'PERCENT 格式.将字符串格式化为百分比.'值乘以 100 并以百分比符号显示.'精度说明符确定小数位数.thisFormat = "#,##0%"precisionSpecifier = CInt(precisionString)如果 LenB(formatGroup) >2 和 precisionSpecifier >0 那么'如果指定了非零精度...thisFormat = "#,##0"thisFormat = (thisFormat & ".") &String$(precisionSpecifier, Chr$(48))否则 '仅指定P"thisFormat = "#,##0"万一'将百分号附加到格式字符串中:thisFormat = thisFormat &%"Case "R", "r" 'ROUND-TRIP 格式(可以往返到相同数字的字符串)'示例:?StringFormat("{0:R}", 0.0000000001141596325677345362656)' ...返回0.000000000114159632567735"'将值转换为双精度(切掉溢出数字):v = CDbl(v)Case "X", "x" 'HEX 格式.将字符串格式化为十六进制值.'精度说明符确定总位数.'返回的字符串以&H"为前缀来指定十六进制.v = 十六进制(v)precisionSpecifier = CInt(precisionString)如果 LenB(precisionString) >0 然后'精度在这里代表左填充v = Right$(String$(precisionSpecifier, "0") & v, IIf(precisionSpecifier = 0, Len(v), precisionSpecifier))万一'添加 C# 十六进制说明符，应用指定的大小写:'(VB6 十六进制说明符会导致 Format() 反转格式):v = "0x" &IIf(formatSpecifier = "X", UCase$(v), LCase$(v))其他情况如果 IsNumeric(formatSpecifier) 和 val(formatGroup) = 0 那么格式说明符 = 格式组v = 格式(v，格式组)别的Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_INVALID_FORMAT_STRING万一结束选择转到 ApplyStringFormat日期时间格式说明符:选择大小写格式说明符Case "c", "C" 'CUSTOM 日期/时间格式'让 VB Format() 按原样解析精度说明符:thisFormat = precisionStringCase "d" 'SHORT DATE 格式thisFormat = "ddddd"Case "D" 'LONG DATE 格式thisFormat = "dddddd"Case "f" 'FULL DATE 格式(短)thisFormat = "dddddd h:mm AM/PM"Case "F" 'FULL DATE 格式(长)thisFormat = "dddddd ttttt"案例g"thisFormat = "ddddd hh:mm AM/PM"案例G"thisFormat = "ddddd ttttt"Case "s" 'SORTABLE DATETIME 格式thisFormat = "yyyy-mm-ddThh:mm:ss"Case "t" 'SHORT TIME 格式thisFormat = "hh:mm AM/PM"Case "T" 'LONG TIME 格式thisFormat = "ttttt"其他情况Err.Raise ERR_FORMAT_EXCEPTION, _ERR_SOURCE、ERR_MSG_INVALID_FORMAT_STRING结束选择转到 ApplyStringFormat万一应用字符串格式:'应用计算格式字符串:formattedValue = Format(v, thisFormat)AlignFormattedValue:'应用指定的对齐说明符:如果alignmentSpecifier <>vbNullString 然后alignmentPadding = Abs(CInt(alignmentSpecifier))如果 CInt(alignmentSpecifier) 0 那么_格式化值 = 格式化值 &_String$(alignmentPadding - Len(formattedValue), PADDING_CHAR)别的'正:右对齐对齐如果alignmentPadding - Len(formattedValue) >0 那么_formattedValue = String$(alignmentPadding - Len(formattedValue), PADDING_CHAR) &格式化值万一万一'用 VB6 十六进制说明符替换 C# 十六进制说明符，'仅当此函数中引入了十六进制说明符时:If (不使用Literal 和escapeHex) And _StringContains(formattedValue, "0x") 然后 _formattedValue = Replace$(formattedValue, "0x", "&H")'用它们的格式化值替换所有出现的占位符 {i}:return_value = Replace(return_value, thisString, formattedValue, Count:=1)'在重申之前重置:thisFormat = vbNullString下一个检查转义:'如果没有更多的反斜杠，不要费心检查其余的:如果 useLiteral 或 Not StringContains(return_value, "\") 然后转到 normalExitDim escape 作为新的转义序列Dim 逃脱为新系列escapes.Add escape.Create("\n", vbNewLine), "0"escapes.Add escape.Create("\q", Chr$(34)), "1"escapes.Add escape.Create("\t", vbTab), "2"escapes.Add escape.Create("\a", Chr$(7)), "3"escapes.Add escape.Create("\b", Chr$(8)), "4"escapes.Add escape.Create("\v", Chr$(13)), "5"escapes.Add escape.Create("\f", Chr$(14)), "6"escapes.Add escape.Create("\r", Chr$(15)), "7"对于 i = 0 转义.计数 - 1设置转义 = 转义(CStr(i))如果 StringContains(return_value, escape.EscapeString) 然后 _返回值 = 替换(返回值，escape.EscapeString，escape.ReplacementString)如果不是 StringContains(return_value, "\") 然后 _转到正常退出下一个'replace "ASCII (oct)" 转义序列设置正则表达式 = 新正则表达式regex.Pattern = "\\(\d{3})"regex.IgnoreCase = Trueregex.Global = True设置匹配 = regex.Execute(format_string)Dim char As Long如果匹配.计数0 那么对于每个 thisMatch In 匹配项p = thisMatch.SubMatches(0)'"p" 包含代表我们所追求的 ASCII 码的八进制数:p = "&O" &p '前置八进制前缀字符 = CLng(p)return_value = Replace(return_value, thisMatch.Value, Chr$(char))下一个万一'如果没有更多的反斜杠，不要费心检查其余的:如果不是 StringContains("\", return_value) Then GoTo normalExit'替换ASCII(十六进制)"转义序列设置正则表达式 = 新正则表达式regex.Pattern = "\\x(\w{2})"regex.IgnoreCase = Trueregex.Global = True设置匹配 = regex.Execute(format_string)如果匹配.计数0 那么对于每个 thisMatch In 匹配项p = thisMatch.SubMatches(0)'"p" 包含表示我们所追求的 ASCII 代码的十六进制值:p = "&H" &p '前置十六进制前缀字符 = CLng(p)return_value = Replace(return_value, thisMatch.Value, Chr$(char))下一个万一正常退出:设置转义符 = 无设置转义 = 无如果不是 useLiteral And StringContains(return_value, Chr$(27)) 然后 _return_value = Replace(return_value, Chr$(27), "\")StringFormat = return_value结束函数注意方法签名中的ParamArray(感谢@wqw):这样做可以避免使用多个可选参数(以及能够分配value2的使用错误)在调用语句中命名参数时不分配 value1).因为它是一个 ParamArray，各个值是 Variant 这意味着每个参数可以是不同的类型，VB 在幕后进行字符串转换.然后可以像这样使用该函数:?StringFormat("(C) 货币:. . . . . . . {0:C}\n" & _"(D) 十进制:. . . . . . . {0:D}\n" &_"(E) 科学:. . . . . . {1:E}\n" &_"(F) 不动点:. . . . . . {1:F}\n" &_"(N) 数:. . . . . . . . {0:N}\n" &_"(P) 百分比:. . . . . . . . {1:P}\n" &_"(R) 往返:. . . . . . {1:R}\n" &_"(X) 十六进制:. . . . . . {0:X}\n",-123, -123.45)输出:(C) 货币:........-123.00$(D) 十进制:.........-123(E) 科学:.......-1.23450E2(F) 固定点:.......-123(N) 编号:.........-123(P) 百分比:.........-12,345%(R) 往返:.......-123.45(X) 十六进制:.......&HFFFFFF85还有这样的:?StringFormat("(c) 自定义格式:. . . . .{0:cYYYY-MM-DD (MMMM)}\n" & _"(d) 短日期:. . . . . . {0:d}\n" &_"(D) 长日期:. . . . . . {0:D}\n" &_"(T) 长时间:. . . . . . {0:T}\n" &_"(f) 完整日期/短时间:. . {0:f}\n" &_"(F) 完整日期/长时间:. . {0:F}\n" &_"(s) 可排序:. . . . . . . {0:s}\n", Now())输出:(c) 自定义格式:......2013-01-26(一月)(d) 短日期:.......1/26/2013(D) 长日期:........2013 年 1 月 26 日星期六(T) 长时间:........晚上 8:28:11(f) 完整日期/短时间: ..2013/1/26 晚上 8:28:11(F) 完整日期/长时间:...2013 年 1 月 26 日星期六晚上 8:28:11(s) 可排序:........2013-01-26T20:28:11也可以指定对齐(/padding)并使用转义序列:?StringFormat ("\q{0}, {1}!\x20\n'{2,10:C2}'\n'{2,-10:C2}'", "hello", "世界", 100)你好，世界！"'100.00$''100.00 美元'查看来自 http://msdn 的示例.microsoft.com/fr-fr/library/b1csw23d(v=vs.80).aspx，只有少数格式说明符没有实现，主要是日期/时间说明符......但我认为c" 自定义日期/时间格式说明符组成.该函数使用了 String.Contains() 的简单实现:公共函数StringContains(string_source As String, find_text As String, _可选 ByVal caseSensitive As Boolean = True) As BooleanStringContains = StringContainsAny(string_source, caseSensitive, find_text)结束函数此代码现在可以正确处理\\"转义，如注释中所述.此外，虽然 StringContains 确实实用并且比 InStr() 调用更舒适，但下面的 StringContainsAny 函数甚至更好:公共函数 StringContainsAny(string_source As String, ByVal caseSensitive As Boolean, _ParamArray find_values()) 作为布尔值Dim i As Integer，发现为布尔值如果区分大小写 那么对于 i = LBound(find_values) 到 UBound(find_values)找到 = (InStr(1, string_source, _find_values(i), vbBinaryCompare) <>0)如果找到然后退出下一个别的对于 i = LBound(find_values) 到 UBound(find_values)StringContainsAny = (InStr(1, LCase$(string_source), _LCase$(find_values(i)), vbBinaryCompare) <>0)如果找到然后退出下一个万一StringContainsAny = 找到结束函数考虑以下事项:foo = Instr(1, source, "value1") >0 或 Instr(1, source, "value2") >0 _或 Instr(1, source, "value3") >0 或 Instr(1, source, "value4") >0 _或 Instr(1, source, "value5") >0 或 Instr(1, source, "value6") >0 _在 VB 确定 foo 是 TRUE 还是 FALSE 之前，每个 InStr() 调用都会进行.然而，对于 StringContainsAny()，条件满足于找到的第一个值，这使其成为更快的语句.之前的编辑几乎消除了转义序列；恢复它们，使用一个小类EscapeSequence"公开两个属性和一个工厂方法 - 这样做可以保持 for-each 循环并处理所有简单的转义，而无需复制大量代码.这段代码还使用了一个 StringStartsWith 函数，实现如下:公共函数 StringStartsWith(ByVal find_text As String, ByVal string_source As String, Optional ByVal caseSensitive As Boolean = True) As Boolean如果区分大小写 那么StringStartsWith = (Left$(string_source, LenB(find_text)/2) = find_text)别的StringStartsWith = (Left$(LCase(string_source), LenB(find_text)/2) = LCase$(find_text))万一结束函数Can String.Format() be implemented in VB6, at least a close-enough version of it that could be useful when programming in good ol' VB6?Good resource on the matter of VB6 string manipulation performance: http://www.aivosto.com/vbtips/stringopt2.htmlOn a related not, I also came up with a couple string comparison functions, find them here on CodeReview.SEThese functions are tremendously useful for improving VB6 readability, especially if you've been spoiled with .net code lately and suddenly are required to dive into a VB6 code base... Enjoy! 解决方案 I couldn't find one anywhere, so I made my own:Public PADDING_CHAR As StringPublic Function StringFormat(format_string As String, ParamArray values()) As String'VB6 implementation of .net String.Format(), slightly customized.'Tested with Office 2010 VBA (x64) Dim return_value As String Dim values_count As Integer 'some error-handling constants: Const ERR_FORMAT_EXCEPTION As Long = vbObjectError Or 9001 Const ERR_ARGUMENT_NULL_EXCEPTION As Long = vbObjectError Or 9002 Const ERR_SOURCE As String = "StringFormat" Const ERR_MSG_INVALID_FORMAT_STRING As String = "Invalid format string." Const ERR_MSG_FORMAT_EXCEPTION As String = "The number indicating an argument to format is less than zero, or greater than or equal to the length of the args array." 'use SPACE as default padding character If PADDING_CHAR = vbNullString Then PADDING_CHAR = Chr$(32) 'figure out number of passed values: values_count = UBound(values) + 1 Dim regex As RegExp Dim matches As MatchCollection Dim thisMatch As Match Dim thisString As String Dim thisFormat As String 'when format_string starts with "@", escapes are not replaced '(string is treated as a literal string with placeholders) Dim useLiteral As Boolean Dim escapeHex As Boolean 'indicates whether HEX specifier "0x" is to be escaped or not 'validate string_format: Set regex = New RegExp regex.Pattern = "{({{)*(\w+)(,-?\d+)?(:[^}]+)?}(}})*" regex.IgnoreCase = True regex.Global = True Set matches = regex.Execute(format_string) 'determine if values_count matches number of unique regex matches: Dim uniqueCount As Integer Dim tmpCSV As String For Each thisMatch In matches If Not StringContains(tmpCSV, thisMatch.SubMatches(1)) Then uniqueCount = uniqueCount + 1 tmpCSV = tmpCSV & thisMatch.SubMatches(1) & "," End If Next 'unique indices count must match values_count: If matches.Count > 0 And uniqueCount <> values_count Then _ Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_FORMAT_EXCEPTION useLiteral = StringStartsWith("@", format_string) 'remove the "@" literal specifier If useLiteral Then format_string = Right(format_string, Len(format_string) - 1) If Not useLiteral And StringContains(format_string, "\\") Then _ format_string = Replace(format_string, "\\", Chr$(27)) If StringContains(format_string, "\\") Then _ format_string = Replace(format_string, "\\", Chr$(27)) If matches.Count = 0 And format_string <> vbNullString And UBound(values) = -1 Then 'only format_string was specified: skip to checking escape sequences: return_value = format_string GoTo checkEscapes ElseIf UBound(values) = -1 And matches.Count > 0 Then Err.Raise ERR_ARGUMENT_NULL_EXCEPTION, _ ERR_SOURCE, ERR_MSG_FORMAT_EXCEPTION End If return_value = format_string 'dissect format_string: Dim i As Integer, v As String, p As String 'i: iterator; v: value; p: placeholder Dim alignmentGroup As String, alignmentSpecifier As String Dim formattedValue As String, alignmentPadding As Integer 'iterate regex matches (each match is a placeholder): For i = 0 To matches.Count - 1 'get the placeholder specified index: Set thisMatch = matches(i) p = thisMatch.SubMatches(1) 'if specified index (0-based) > uniqueCount (1-based), something's wrong: If p > uniqueCount - 1 Then _ Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_FORMAT_EXCEPTION v = values(p) 'get the alignment specifier if it is specified: alignmentGroup = thisMatch.SubMatches(2) If alignmentGroup <> vbNullString Then _ alignmentSpecifier = Right$(alignmentGroup, LenB(alignmentGroup) / 2 - 1) 'get the format specifier if it is specified: thisString = thisMatch.Value If StringContains(thisString, ":") Then Dim formatGroup As String, precisionSpecifier As Integer Dim formatSpecifier As String, precisionString As String 'get the string between ":" and "}": formatGroup = Mid$(thisString, InStr(1, thisString, ":") + 1, (LenB(thisString) / 2) - 2) formatGroup = Left$(formatGroup, LenB(formatGroup) / 2 - 1) precisionString = Right$(formatGroup, LenB(formatGroup) / 2 - 1) formatSpecifier = Mid$(thisString, InStr(1, thisString, ":") + 1, 1) 'applicable formatting depends on the type of the value (yes, GOTO!!): If TypeName(values(p)) = "Date" Then GoTo DateTimeFormatSpecifiers If v = vbNullString Then GoTo ApplyStringFormatNumberFormatSpecifiers: If precisionString <> vbNullString And Not IsNumeric(precisionString) Then _ Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_INVALID_FORMAT_STRING If precisionString = vbNullString Then precisionString = 0 Select Case formatSpecifier Case "C", "c" 'CURRENCY format, formats string as currency. 'Precision specifier determines number of decimal digits. 'This implementation ignores regional settings '(hard-coded group separator, decimal separator and currency sign). precisionSpecifier = CInt(precisionString) thisFormat = "#,##0.$" If LenB(formatGroup) > 2 And precisionSpecifier > 0 Then 'if a non-zero precision is specified... thisFormat = _ Replace$(thisFormat, ".", "." & String$(precisionString, Chr$(48))) End If Case "D", "d" 'DECIMAL format, formats string as integer number. 'Precision specifier determines number of digits in returned string. precisionSpecifier = CInt(precisionString) thisFormat = "0" thisFormat = Right$(String$(precisionSpecifier, "0") & thisFormat, _ IIf(precisionSpecifier = 0, Len(thisFormat), precisionSpecifier)) Case "E", "e" 'EXPONENTIAL NOTATION format (aka "Scientific Notation") 'Precision specifier determines number of decimals in returned string. 'This implementation ignores regional settings' '(hard-coded decimal separator). precisionSpecifier = CInt(precisionString) thisFormat = "0.00000#" & formatSpecifier & "-#" 'defaults to 6 decimals If LenB(formatGroup) > 2 And precisionSpecifier > 0 Then 'if a non-zero precision is specified... thisFormat = "0." & String$(precisionSpecifier - 1, Chr$(48)) & "#" & formatSpecifier & "-#" ElseIf LenB(formatGroup) > 2 And precisionSpecifier = 0 Then Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_INVALID_FORMAT_STRING End If Case "F", "f" 'FIXED-POINT format 'Precision specifier determines number of decimals in returned string. 'This implementation ignores regional settings' '(hard-coded decimal separator). precisionSpecifier = CInt(precisionString) thisFormat = "0" If LenB(formatGroup) > 2 And precisionSpecifier > 0 Then 'if a non-zero precision is specified... thisFormat = (thisFormat & ".") & String$(precisionSpecifier, Chr$(48)) Else 'no precision specified - default to 2 decimals: thisFormat = "0.00" End If Case "G", "g" 'GENERAL format (recursive) 'returns the shortest of either FIXED-POINT or SCIENTIFIC formats in case of a Double. 'returns DECIMAL format in case of a Integer or Long. Dim eNotation As String, ePower As Integer, specifier As String precisionSpecifier = IIf(CInt(precisionString) > 0, CInt(precisionString), _ IIf(StringContains(v, "."), Len(v) - InStr(1, v, "."), 0)) 'track character case of formatSpecifier: specifier = IIf(formatSpecifier = "G", "D", "d") If TypeName(values(p)) = "Integer" Or TypeName(values(p)) = "Long" Then 'Integer types: use {0:D} (recursive call): formattedValue = StringFormat("{0:" & specifier & "}", values(p)) ElseIf TypeName(values(p)) = "Double" Then 'Non-integer types: use {0:E} specifier = IIf(formatSpecifier = "G", "E", "e") 'evaluate the exponential notation value (recursive call): eNotation = StringFormat("{0:" & specifier & "}", v) 'get the power of eNotation: ePower = Mid$(eNotation, InStr(1, UCase$(eNotation), "E-") + 1, Len(eNotation) - InStr(1, UCase$(eNotation), "E-")) If ePower > -5 And Abs(ePower) < precisionSpecifier Then 'use {0:F} when ePower > -5 and abs(ePower) < precisionSpecifier: 'evaluate the floating-point value (recursive call): specifier = IIf(formatSpecifier = "G", "F", "f") formattedValue = StringFormat("{0:" & formatSpecifier & _ IIf(precisionSpecifier <> 0, precisionString, vbNullString) & "}", values(p)) Else 'fallback to {0:E} if previous rule didn't apply: formattedValue = eNotation End If End If GoTo AlignFormattedValue 'Skip the "ApplyStringFormat" step, it's applied already. Case "N", "n" 'NUMERIC format, formats string as an integer or decimal number. 'Precision specifier determines number of decimal digits. 'This implementation ignores regional settings' '(hard-coded group and decimal separators). precisionSpecifier = CInt(precisionString) If LenB(formatGroup) > 2 And precisionSpecifier > 0 Then 'if a non-zero precision is specified... thisFormat = "#,##0" thisFormat = (thisFormat & ".") & String$(precisionSpecifier, Chr$(48)) Else 'only the "D" is specified thisFormat = "#,##0" End If Case "P", "p" 'PERCENT format. Formats string as a percentage. 'Value is multiplied by 100 and displayed with a percent symbol. 'Precision specifier determines number of decimal digits. thisFormat = "#,##0%" precisionSpecifier = CInt(precisionString) If LenB(formatGroup) > 2 And precisionSpecifier > 0 Then 'if a non-zero precision is specified... thisFormat = "#,##0" thisFormat = (thisFormat & ".") & String$(precisionSpecifier, Chr$(48)) Else 'only the "P" is specified thisFormat = "#,##0" End If 'Append the percentage sign to the format string: thisFormat = thisFormat & "%" Case "R", "r" 'ROUND-TRIP format (a string that can round-trip to an identical number) 'example: ?StringFormat("{0:R}", 0.0000000001141596325677345362656) ' ...returns "0.000000000114159632567735" 'convert value to a Double (chop off overflow digits): v = CDbl(v) Case "X", "x" 'HEX format. Formats a string as a Hexadecimal value. 'Precision specifier determines number of total digits. 'Returned string is prefixed with "&H" to specify Hex. v = Hex(v) precisionSpecifier = CInt(precisionString) If LenB(precisionString) > 0 Then 'precision here stands for left padding v = Right$(String$(precisionSpecifier, "0") & v, IIf(precisionSpecifier = 0, Len(v), precisionSpecifier)) End If 'add C# hex specifier, apply specified casing: '(VB6 hex specifier would cause Format() to reverse the formatting): v = "0x" & IIf(formatSpecifier = "X", UCase$(v), LCase$(v)) Case Else If IsNumeric(formatSpecifier) And val(formatGroup) = 0 Then formatSpecifier = formatGroup v = Format(v, formatGroup) Else Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_INVALID_FORMAT_STRING End If End Select GoTo ApplyStringFormatDateTimeFormatSpecifiers: Select Case formatSpecifier Case "c", "C" 'CUSTOM date/time format 'let VB Format() parse precision specifier as is: thisFormat = precisionString Case "d" 'SHORT DATE format thisFormat = "ddddd" Case "D" 'LONG DATE format thisFormat = "dddddd" Case "f" 'FULL DATE format (short) thisFormat = "dddddd h:mm AM/PM" Case "F" 'FULL DATE format (long) thisFormat = "dddddd ttttt" Case "g" thisFormat = "ddddd hh:mm AM/PM" Case "G" thisFormat = "ddddd ttttt" Case "s" 'SORTABLE DATETIME format thisFormat = "yyyy-mm-ddThh:mm:ss" Case "t" 'SHORT TIME format thisFormat = "hh:mm AM/PM" Case "T" 'LONG TIME format thisFormat = "ttttt" Case Else Err.Raise ERR_FORMAT_EXCEPTION, _ ERR_SOURCE, ERR_MSG_INVALID_FORMAT_STRING End Select GoTo ApplyStringFormat End IfApplyStringFormat: 'apply computed format string: formattedValue = Format(v, thisFormat)AlignFormattedValue: 'apply specified alignment specifier: If alignmentSpecifier <> vbNullString Then alignmentPadding = Abs(CInt(alignmentSpecifier)) If CInt(alignmentSpecifier) < 0 Then 'negative: left-justified alignment If alignmentPadding - Len(formattedValue) > 0 Then _ formattedValue = formattedValue & _ String$(alignmentPadding - Len(formattedValue), PADDING_CHAR) Else 'positive: right-justified alignment If alignmentPadding - Len(formattedValue) > 0 Then _ formattedValue = String$(alignmentPadding - Len(formattedValue), PADDING_CHAR) & formattedValue End If End If 'Replace C# hex specifier with VB6 hex specifier, 'only if hex specifier was introduced in this function: If (Not useLiteral And escapeHex) And _ StringContains(formattedValue, "0x") Then _ formattedValue = Replace$(formattedValue, "0x", "&H") 'replace all occurrences of placeholder {i} with their formatted values: return_value = Replace(return_value, thisString, formattedValue, Count:=1) 'reset before reiterating: thisFormat = vbNullString NextcheckEscapes: 'if there's no more backslashes, don't bother checking for the rest: If useLiteral Or Not StringContains(return_value, "\") Then GoTo normalExit Dim escape As New EscapeSequence Dim escapes As New Collection escapes.Add escape.Create("\n", vbNewLine), "0" escapes.Add escape.Create("\q", Chr$(34)), "1" escapes.Add escape.Create("\t", vbTab), "2" escapes.Add escape.Create("\a", Chr$(7)), "3" escapes.Add escape.Create("\b", Chr$(8)), "4" escapes.Add escape.Create("\v", Chr$(13)), "5" escapes.Add escape.Create("\f", Chr$(14)), "6" escapes.Add escape.Create("\r", Chr$(15)), "7" For i = 0 To escapes.Count - 1 Set escape = escapes(CStr(i)) If StringContains(return_value, escape.EscapeString) Then _ return_value = Replace(return_value, escape.EscapeString, escape.ReplacementString) If Not StringContains(return_value, "\") Then _ GoTo normalExit Next 'replace "ASCII (oct)" escape sequence Set regex = New RegExp regex.Pattern = "\\(\d{3})" regex.IgnoreCase = True regex.Global = True Set matches = regex.Execute(format_string) Dim char As Long If matches.Count <> 0 Then For Each thisMatch In matches p = thisMatch.SubMatches(0) '"p" contains the octal number representing the ASCII code we're after: p = "&O" & p 'prepend octal prefix char = CLng(p) return_value = Replace(return_value, thisMatch.Value, Chr$(char)) Next End If 'if there's no more backslashes, don't bother checking for the rest: If Not StringContains("\", return_value) Then GoTo normalExit 'replace "ASCII (hex)" escape sequence Set regex = New RegExp regex.Pattern = "\\x(\w{2})" regex.IgnoreCase = True regex.Global = True Set matches = regex.Execute(format_string) If matches.Count <> 0 Then For Each thisMatch In matches p = thisMatch.SubMatches(0) '"p" contains the hex value representing the ASCII code we're after: p = "&H" & p 'prepend hex prefix char = CLng(p) return_value = Replace(return_value, thisMatch.Value, Chr$(char)) Next End IfnormalExit: Set escapes = Nothing Set escape = Nothing If Not useLiteral And StringContains(return_value, Chr$(27)) Then _ return_value = Replace(return_value, Chr$(27), "\") StringFormat = return_valueEnd FunctionNotice the ParamArray in the method signature (thanks @wqw): doing so spares the usage of multiple optional parameters (and from usage bugs with being able to assign value2 without assigning value1 when naming the parameters in the calling statement). Because it's a ParamArray, the individual values are Variant which means every parameter could be of a different type, VB is doing the string conversion behind the scenes.The function can then be consumed like this:?StringFormat("(C) Currency: . . . . . . . . {0:C}\n" & _ "(D) Decimal:. . . . . . . . . {0:D}\n" & _ "(E) Scientific: . . . . . . . {1:E}\n" & _ "(F) Fixed point:. . . . . . . {1:F}\n" & _ "(N) Number: . . . . . . . . . {0:N}\n" & _ "(P) Percent:. . . . . . . . . {1:P}\n" & _ "(R) Round-trip: . . . . . . . {1:R}\n" & _ "(X) Hexadecimal:. . . . . . . {0:X}\n",-123, -123.45)Output:(C) Currency: . . . . . . . . -123.00$(D) Decimal:. . . . . . . . . -123(E) Scientific: . . . . . . . -1.23450E2(F) Fixed point:. . . . . . . -123(N) Number: . . . . . . . . . -123(P) Percent:. . . . . . . . . -12,345%(R) Round-trip: . . . . . . . -123.45(X) Hexadecimal:. . . . . . . &HFFFFFF85And also like this:?StringFormat("(c) Custom format: . . . . . .{0:cYYYY-MM-DD (MMMM)}\n" & _ "(d) Short date: . . . . . . . {0:d}\n" & _ "(D) Long date:. . . . . . . . {0:D}\n" & _ "(T) Long time:. . . . . . . . {0:T}\n" & _ "(f) Full date/short time: . . {0:f}\n" & _ "(F) Full date/long time:. . . {0:F}\n" & _ "(s) Sortable: . . . . . . . . {0:s}\n", Now())Output:(c) Custom format: . . . . . .2013-01-26 (January)(d) Short date: . . . . . . . 1/26/2013(D) Long date:. . . . . . . . Saturday, January 26, 2013(T) Long time:. . . . . . . . 8:28:11 PM(f) Full date/short time: . . 1/26/2013 8:28:11 PM(F) Full date/long time:. . . Saturday, January 26, 2013 8:28:11 PM(s) Sortable: . . . . . . . . 2013-01-26T20:28:11Also possible to specify alignment (/padding) and to use escape sequences:?StringFormat ("\q{0}, {1}!\x20\n'{2,10:C2}'\n'{2,-10:C2}'", "hello", "world", 100)"hello, world!"' 100.00$''100.00$ 'Looking at samples from http://msdn.microsoft.com/fr-fr/library/b1csw23d(v=vs.80).aspx, only a few format specifiers are not implemented, mostly date/time specifiers... but I would think the "c" custom date/time format specifier makes it up.The function uses a straightforward implementation of String.Contains():Public Function StringContains(string_source As String, find_text As String, _ Optional ByVal caseSensitive As Boolean = True) As Boolean StringContains = StringContainsAny(string_source, caseSensitive, find_text)End FunctionEDIT: This code now properly handles "\\" escapes, as mentioned in the comments. Also, while StringContains is certainly practical and gives a more comfortable reading than an InStr() call, the below StringContainsAny function is even better:Public Function StringContainsAny(string_source As String, ByVal caseSensitive As Boolean, _ ParamArray find_values()) As Boolean Dim i As Integer, found As Boolean If caseSensitive Then For i = LBound(find_values) To UBound(find_values) found = (InStr(1, string_source, _ find_values(i), vbBinaryCompare) <> 0) If found Then Exit For Next Else For i = LBound(find_values) To UBound(find_values) StringContainsAny = (InStr(1, LCase$(string_source), _ LCase$(find_values(i)), vbBinaryCompare) <> 0) If found Then Exit For Next End If StringContainsAny = foundEnd FunctionConsider the following:foo = Instr(1, source, "value1") > 0 Or Instr(1, source, "value2") > 0 _ Or Instr(1, source, "value3") > 0 Or Instr(1, source, "value4") > 0 _ Or Instr(1, source, "value5") > 0 Or Instr(1, source, "value6") > 0 _Before VB can determine if foo is TRUE or FALSE, every single InStr() call is made. However with StringContainsAny(), the condition is satisfied with the first value that gets found, which makes it a faster statement.EDIT: Previous edit pretty much wiped out escape sequences; reinstated them, using a small class "EscapeSequence" exposing two properties and a factory method - doing this allows keeping the for-each loop and handling all simple escapes without duplicating much code.This code also uses a StringStartsWith function, implemented like this:Public Function StringStartsWith(ByVal find_text As String, ByVal string_source As String, Optional ByVal caseSensitive As Boolean = True) As Boolean If caseSensitive Then StringStartsWith = (Left$(string_source, LenB(find_text) / 2) = find_text) Else StringStartsWith = (Left$(LCase(string_source), LenB(find_text) / 2) = LCase$(find_text)) End IfEnd Function 这篇关于在 VB6 中实现 String.Format()的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！