VB6 - VConvert, A Class for Locale-Specific Data Conversions

[dilettante]

There are times when you need another option for wading through the localization minefield.

There are many things in VB6 that are locale-aware, such as CStr, CSng, CDate, Print #, etc. When you need to bypass this and use "universal" (invariant) locale conversion there are always the Str$() and Val() functions but these come with some baggage such as forcing numbers through a specific type which can result in loss of precision.

There is another option, and this one lets you use the invariant locale or even a specific locale for a wide range of data types.

While there is some overhead because it uses Variants, most of the time the benefits outweigh this cost. And it can still be faster (and less prone to bugs) than a lot of alternative logic people whang together to try to do the same thing.


I have wrapped it as a class here, but it is just an API call that you could inline just as well with care. I find the class convenient because usually I just set the locale I want once and then I can do a number of conversions without the need to respecify it every time.

Option Explicit
'
'VConvert
'--------
'
'A VB6 class used to convert between Variant types using a specific
'locale instead of the current program locale.
'
'This is most useful with LOCALE_INVARIANT for non-String typed data
'that is perisisted or communicated as String data.  This avoids
'cross-cultural factors related to language, the decimal point
'character, etc.
'
'It can also be used with conversions of data between a user
'interface and data where your code assumes a fixed locale and you
'want to insist users work in that locale even when the user locale
'is an entirely different one.  Note that this is not a recommended
'practice for most software!
'
'Example:
'
'    Program always expects dates to be entered in U.S. format,
'    i.e. mm/dd/yyyy but some users have U.K. settings which make
'    locale-aware conversions such as CDate() expect strings in
'    dd/mm/yyyy format.
'

Private Const S_OK As Long = 0
Private Const VARIANT_ALPHABOOL As Long = &H2&
Private Const VARIANT_LOCALBOOL As Long = &H10&

Public Enum LCIDs
    'Add more as you need them here:
    LOCALE_INVARIANT = 127&
End Enum

Private Declare Function VariantChangeTypeEx Lib "oleaut32" ( _
    ByRef vargDest As Variant, _
    ByRef varSrc As Variant, _
    ByVal desiredlcid As Long, _
    ByVal wFlags As Integer, _
    ByVal vt As VbVarType) As Long

Public LCID As Long

'Default property:
Public Property Get Convert(ByVal Value As Variant, ByVal ToType As VbVarType) As Variant
    If VariantChangeTypeEx(Convert, _
                           Value, _
                           LCID, _
                           VARIANT_ALPHABOOL _
                        Or VARIANT_LOCALBOOL, _
                           ToType) <> S_OK Then
        Err.Raise 5, TypeName(Me), "Conversion failed"
    End If
End Property

Private Sub Class_Initialize()
    LCID = LOCALE_INVARIANT
End Sub

The LCIDs Enum is really just there for the LOCALE_INVARIANT constant, but you can add specific locales to the list as well if you frequently require them.

[dilettante]

What I haven't tracked down yet is an equivalent of Format$() that accepts an LCID argument.

Edit:

See post #10 below for a VConvert class based on suggestions below.

[Schmidt]

What I haven't tracked down yet is an equivalent of Format$() that accepts an LCID argument.

Here you go (though not intensively tested yet)...

Private Declare Function VarTokenizeFormatString Lib "oleaut32.dll" (ByVal pstrFormat As Long, ByRef rgbTok As Any, ByVal cbTok As Long, ByVal iFirstDay As VbDayOfWeek, ByVal iFirstWeek As VbFirstWeekOfYear, ByVal LCID As Long, Optional ByVal pcbActual As Long) As Long
Private Declare Function VarFormatFromTokens Lib "oleaut32.dll" (ByRef pvarIn As Variant, ByVal pstrFormat As Long, ByRef pbTokCur As Any, ByVal dwFlags As Long, ByVal pbstrOut As Long, ByVal LCID As Long) As Long
 
Public Function FormatLA(Expression As Variant, Optional Format As String, Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, Optional ByVal FirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem, Optional ByVal TargetLCID As Long, Optional ByVal PatternLCID As Long = 1033) As String
Static hRes As Long, B(0 To 4095) As Byte

  hRes = VarTokenizeFormatString(StrPtr(Format), B(0), UBound(B) + 1, FirstDayOfWeek, FirstWeekOfYear, PatternLCID)
  If hRes Then Err.Raise hRes
 
  hRes = VarFormatFromTokens(Expression, StrPtr(Format), B(0), 0, ByVal VarPtr(FormatLA), TargetLCID)
  If hRes Then Err.Raise hRes
End Function

Oh, and in your function above, the Variant-input-Param could be left at ByRef, to avoid unnecessary extra-allocations in case of e.g. String-content in this Param.
...Public Property Get Convert(ByVal Value As Variant, ...
The above Value-Param I mean.

Olaf

[dilettante]

Oh, and in your function above, the Variant-input-Param could be left at ByRef, to avoid unnecessary extra-allocations in case of e.g. String-content in this Param.
...Public Property Get Convert(ByVal Value As Variant, ...
The above Value-Param I mean.

Olaf

Are you sure about that?

Since the API call requires a Variant, VB6 is just going to make a copy anyway. Why not do it explicitly at the top of the function by specifying ByVal?

[dilettante]

Here you go (though not intensively tested yet)...

That looks like a good solution.

[Schmidt]

Are you sure about that?
Since the API call requires a Variant, VB6 is just going to make a copy anyway. Why not do it explicitly at the top of the function by specifying ByVal?

No - the VB-compiler avoids making copies of "normal types" passed into a Byref-Variant-Param - as long as the "chain of ByRef-Variants" is not broken,
... in-between the VB-App which is using the Class.Convert-method - and the final API-call which was defined:
...Private Declare Function VariantChangeTypeEx Lib "oleaut32" ( ByRef vargDest As Variant, ByRef varSrc As Variant, _...
having varSrc As Variant defined ByRef too.

In this case VB creates only one temporary Variant-Transport-Hull at the Callers side - sets the internal VariantValue to the *Pointer* of the
"original Variable which is to be transported in the VariantHull" - and sets the correct VariantType (according to the original Variable-Type which is transported) ...
the VT-member of the Variant then additionally OR-ed with the VT_BYREF flag - before the Pointer to the Variant itself is passed along as a ByRef-param onto the callstack.

When calling APIs which do not perform overly much underneath, the positive effects of this VT_BYREF-calling become measurable...
The content of the original Variable is not touched at all (no copy made) - and especially when we talk about Strings or other sidewards allocated content,
then this can pay off, if the API-call in question is a candidate to be called potentially with high frequencies in a loop (and type-conversion-functions are candidates for that).

All the VBRuntime-functions which accept "anything" (e.g. Left$, Mid$ - and whatnot) have ByRef-Variants as TransportHull-Params and use the VT_ByRef-scheme,
passing only the Pointer to the original Variable).

Here's a small performance-comparison (just to paste into a Form, then click the Form):

Option Explicit

Private Declare Function VariantChangeTypeEx Lib "oleaut32" ( _
    ByRef vargDest As Variant, ByRef varSrc As Variant, _
    ByVal desiredlcid As Long, ByVal wFlags As Integer, ByVal vt As VbVarType) As Long
 
Private Sub Form_Click()
Dim i As Long, S As String, C As Currency, T As Single
Const LoopCount = 1000000

  S = "12345678987654.321"
  
  T = Timer
    For i = 1 To LoopCount
      C = Convert(S, vbCurrency)
    Next i
  Print "ByVal-VariantParam", Timer - T
  
  T = Timer
    For i = 1 To LoopCount
      C = ConvertByRef(S, vbCurrency)
    Next i
  Print "ByRef-VariantParam", Timer - T
End Sub

Public Property Get Convert(ByVal Value As Variant, ByVal ToType As VbVarType) As Variant
Dim hRes As Long
  hRes = VariantChangeTypeEx(Convert, Value, 1033, &H12&, ToType)
  If hRes Then Err.Raise hRes
End Property

Public Property Get ConvertByRef(ByRef Value As Variant, ByVal ToType As VbVarType) As Variant
Dim hRes As Long
  hRes = VariantChangeTypeEx(ConvertByRef, Value, 1033, &H12&, ToType)
  If hRes Then Err.Raise hRes
End Property

Not meant as Nit-Picking - more as a hint, to not undermine the intention of the ByRef-Src-Variant in the original API.

Olaf

[dilettante]

Ahh, so what we have here is part of the Declare calling mechanism?

So then what happens if that Declare is replaced by a type library defining the API call signature instead?

[Schmidt]

Ahh, so what we have here is part of the Declare calling mechanism?

So then what happens if that Declare is replaced by a type library defining the API call signature instead?

There would be no change in behaviour in case of a Typelib-defined Call.

The VT_BYRef mechanism is always in place - independently - also with VBs normal (internal) Function- and Property Defintions.

As soon as we declare a ByRef-Variant-Param, the VB-Compiler will not only pass the Variant-Param itself
as only a Pointer onto the Stack - but in *addition* it will always ensure, that also the original Variable
will be passed inside the Variant-Value-MemberField as only a Pointer - and this "indirect content" of the
Variants Value-Field is "flagged" appropriately with the additionally OR-ed VT_ByRef-Constant.

If you ask a VB-Byref-Variant for this Flag per VBs VarType-function, it will be suppressed (masked out) -
and you will get back only the normal "Variant-Content-Type-Flagging" from the VarType-function.

You will have to use CopyMemory and copy the 2-Byte of the Variants Type-Member manually,
to see the set VT_ByRef-Flag indeed in place on VBs ByRef Variant-Params.

Here's some test-code.

Option Explicit

Private Const VT_BYREF = &H4000
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal CB&)

Private Sub Form_Load()
  Me.Width = Screen.Width / 3 'just to ensure the printed-results are not cut-off
  Me.Caption = "Click Me"
End Sub

Private Sub Form_Click()
Dim B As Byte
  
  B = 123
  Print "Routine", "ValuePtr", "VariantPtr", "the real VT", "result of VBs VarType"
  Print "FormClick", VarPtr(B)
  Test B
End Sub

Public Sub Test(ByRef V)
Dim VT As Integer, pData As Long
  MemCopy VT, ByVal VarPtr(V), 2
  MemCopy pData, ByVal VarPtr(V) + 8, 4 'copy the pointer of the Value-Variable
  Print "Test", pData, VarPtr(V), "&H"; Hex(VT), "&H00"; Hex(VarType(V))
  
  SubTest V
End Sub

Public Sub SubTest(ByRef V)
Dim VT As Integer, pData As Long
  MemCopy VT, ByVal VarPtr(V), 2
  MemCopy pData, ByVal VarPtr(V) + 8, 4 'copy the pointer of the Value-Variable
  Print "SubTest", pData, VarPtr(V), "&H"; Hex(VT), "&H00"; Hex(VarType(V))
End Sub

Olaf

[dilettante]

Thanks. Good information to know.

[dilettante]

I should have posted this earlier:

[Arnoutdv]

Thanks for providing this.
I modified it for my own needs by adding the 2 date parameters:

Public Property Get Format(ByVal Value As Variant, ByVal FormatString As String, _
                           Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
                           Optional ByVal FirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem) As String
    Dim Result As Long
    
    Do
        Result = VarTokenizeFormatString(StrPtr(FormatString), _
                                         TokBuf(0), _
                                         TokBufSize, _
                                         FirstDayOfWeek, _
                                         FirstWeekOfYear, _
                                         LCID)
        Select Case Result
            Case S_OK
                'Fall through.
            Case DISP_E_BUFFERTOOSMALL
                TokBufSize = TokBufSize + TOK_BUF_CHUNK
                ReDim TokBuf(TokBufSize - 1)
            Case Else
                'Error.
                Err.Raise 5, TypeName(Me) 'Invalid procedure call or argument.
                Exit Property
        End Select
    Loop Until Result = S_OK
    
    If VarFormatFromTokens(Value, _
                           StrPtr(FormatString), _
                           TokBuf(0), _
                           0, _
                           VarPtr(Format), _
                           LCID) Then Err.Raise 5 'Invalid procedure call or argument.
End Property

[dilettante]

Good call. Thanks for sharing.

[labmany]

Thanks, will come handy indeed with a multi-language project I have.

[dilettante]

The Invariant Locale is useful for data your program saves as text and for values in data exchanged as text over networks. Then everything works no matter what regional and language settings a user has.

For reporting and displaying though you'll probably want to use the current user locale. Just be aware that for some currency values the currency symbol is supposed to follow the number instead of preceding it, and sometimes the number of decimal places is other than 2 digits. To get the currency symbol and know where to place it, etc. additional calls are required.

    Dim Chars As Long
    Dim CurrencyFractDigits As String
    Dim CurrencySymbolPosition As String
    Dim CurrencySymbol As String

    'Create locale-aware CurrencyFormat string:
    Chars = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICURRDIGITS, 0, 0)
    CurrencyFractDigits = Space$(Chars - 1)
    GetLocaleInfo LOCALE_USER_DEFAULT, LOCALE_ICURRDIGITS, StrPtr(CurrencyFractDigits), Chars
    CurrencyFormat = "#,##0." & String$(CLng(CurrencyFractDigits), "0")
    Chars = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICURRENCY, 0, 0)
    CurrencySymbolPosition = Space$(Chars - 1)
    GetLocaleInfo LOCALE_USER_DEFAULT, LOCALE_ICURRENCY, StrPtr(CurrencySymbolPosition), Chars
    Chars = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, 0, 0)
    CurrencySymbol = Space$(Chars - 1)
    GetLocaleInfo LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, StrPtr(CurrencySymbol), Chars
    Select Case CLng(CurrencySymbolPosition)
        Case 0
            CurrencyFormat = CurrencySymbol & CurrencyFormat
        Case 1
            CurrencyFormat = CurrencyFormat & CurrencySymbol
        Case 2
            CurrencyFormat = CurrencySymbol & " " & CurrencyFormat
        Case 3
            CurrencyFormat = CurrencyFormat & " " & CurrencySymbol
    End Select

For the definitions see GroidItem.ctl in the attachment at: http://www.vbforums.com/showthread.p...=1#post5230477

Note that this code does not take LOCALE_SGROUPING into consideration. Find that in your MSDN documentation under "LCTYPE Constants."

LOCALE_SGROUPING = &H10&

Sizes for each group of digits to the left of the decimal. An explicit size is needed for each group; sizes are separated by semicolons. If the last value is zero, the preceding value is repeated. To group thousands, specify 3;0, for example.

[labmany]

Thanks dilettante