Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Storing Values From Multiple Regional Settings
Author:
James Longstreet
Submitted:
1/26/2006
Version:
VB6
Compatibility:
VB5, VB6
Category:
String Manipulation
Views:
15765
In the class below, when declaring a number and passing it to a database, initialize the variable as vCurrency (or vDouble - in which case, modify the variable type in the class). In the pass of the value to a storage place where User will read it again, pass the vUSACurrency value so that user can always work with default imperial values of Visual Basic. Let the user's regional settings handle formatting on the screen. The case below uses decimal values which may not provide User with adequate accuracy. If so, User should change them to single or double rather than decimal. Decimals are accurate to 4 places, Singles to 8 places and Doubles to 16 places. This code contains both module (for obtaining default regional values) and the class code (for conversion).
Declarations:
'Public Const LOCALE_SDECIMAL = &HE
Code:
'Example: 'Dim krnc as clsCurrency 'Set krnc = New clsCurrency 'to use the regional language krnc.vCurrency = 12,8333 (uses comma) 'Debug.print krnc.vUSACurrency => 12.8333 (returns decimal point) 'Now pass the Imperial value to the software subroutine 'Likewise the opposite is true 'to use the stored value krnc.vUSACurrency = 12.8333 (uses decimal point) 'Debug.print krnc.vCurrency => 12,8333 (returns comma or decimal point depending on the regional setting) 'Now pass the Regional value to the software subroutine 'local variable(s) to hold property value(s) ' Private mvarUSACurrency As Variant 'local copy Private mvarvCurrency As Variant 'local copy Friend Property Get localComma() As String localComma = Replace(winlocaleinfo(&HC), Chr(0), "") '&HB End Property Friend Property Get localDollarSign() As String localDollarSign = Replace(winlocaleinfo(&H14), Chr(0), "") 'GetCurrencySymbol End Property Friend Property Get localDecimal() As String localDecimal = Replace(winlocaleinfo(&HE), Chr(0), "") End Property Public Property Let vCurrency(ByVal vData As Variant) On Error Resume Next If vData = vbNullString Then vData = 0 mvarvCurrency = vData If Not localDecimal = "." Then mvarUSACurrency = Replace(CCur(vData), localDecimal, ".") If Err.number > 0 Then mvarUSACurrency = val(vData) Else mvarUSACurrency = vData End If End Property Public Property Get vCurrency() As Variant If Not IsNumeric(mvarvCurrency) Then mvarvCurrency = 0 End If vCurrency = CCur(mvarvCurrency) End Property Public Property Let vUSACurrency(ByVal vData As Variant) If Not localDecimal = "." Then If InStrB(vData, localDecimal) > 0 Then mvarvCurrency = Replace(vData, ".", localDecimal) ElseIf InStrB(vData, ".") > 0 Then mvarvCurrency = Replace(vData, ".", localDecimal) Else 'no punctuation in string mvarvCurrency = vData mvarUSACurrency = vData End If End If If InStrB(vData, localDecimal) > 0 Then mvarUSACurrency = Replace(vData, localDecimal, ".") mvarvCurrency = vData ElseIf InStrB(vData, ".") > 0 Then mvarUSACurrency = Replace(vData, localDecimal, ".") Else 'no punctuation in string mvarUSACurrency = vData mvarvCurrency = vData End If End Property Public Property Get vUSACurrency() As Variant vUSACurrency = mvarUSACurrency End Property 'Place the following in a module Private Declare Function GetLocaleInfo Lib "kernel32.dll" _ Alias "GetLocaleInfoA" _ (ByVal Locale As Long, _ ByVal LCType As Long, _ ByVal lpLCData As String, _ ByVal cchData As Long) As Long Public Function winlocaleinfo(ByVal infotype As Long) As String Dim slcdata As String Dim nRet As Long nRet = GetLocaleInfo(0, infotype, slcdata, 0) If nRet Then slcdata = Space$(nRet) nRet = GetLocaleInfo(0, infotype, slcdata, Len(slcdata)) If nRet Then winlocaleinfo = Left(slcdata, nRet) End If End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement