VB and VBA Users Source Code: Obtaining regional setting information
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Obtaining regional setting information
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, June 05, 2003
Hits:
1175
Category:
Windows API
Article:
The function below returns regional setting information (as show in the "Regional Options" section of the Control Panel). Option Explicit Public Enum eInternational eiCountryID eiCountryName eiCurrDigits eiCurrencyID eiCurrencySymbol eiDateID eiDateSeperator eiDigits eiLZero eiMeasure eiNegCurr eiTimeSeperator eiTLZero eiLocale eiAM eiPM eiDecimal eiLanguage eiList eiLongDate eiShortDate eiThousand eiTimeID eiTimeFormat eiTimePrefix eiMonDecimalSep eiMonThousandSep eiNegNumber eiNativeDigits eiNumShape eiCalendarType eiFirstDayOfWeek eiFirstWeekOfYear eiGrouping eiMonGrouping eiPositiveSign eiNegativeSign End Enum Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 'Purpose : Returns regional setting information from (as show in the "Regional Options" section of the Control Panel) 'Inputs : eSetting The regional setting to return. ' [sDefault] The default value to return if no setting is found. 'Outputs : Returns True on success 'Author : Andrew Baker 'Date : 25/05/2002 'Example : FormMenuColour Me.hwnd, vbRed, True 'Notes : Function RegionSetting(eSetting As eInternational, Optional sDefault As String = "") As String Const REG_SZ = 1, HKEY_CURRENT_USER = &H80000001, REG_BINARY = 3, ERROR_SUCCESS As Long = 0 Dim sSetting As String, sValueName As String Dim lValueType As Long, sBuffer As String, lDataBufSize As Long, iValue As Long, lhKey As Long Select Case eSetting Case eiCountryID sSetting = "iCountry" Case eiCurrDigits sSetting = "iCurrDigits" Case eiCurrencyID sSetting = "iCurrency" Case eiDateID sSetting = "iDate" Case eiDigits sSetting = "iDigits" Case eiLZero sSetting = "iLZero" Case eiMeasure sSetting = "iMeasure" Case eiNegCurr sSetting = "iNegCurr" Case eiTimeID sSetting = "iTime" Case eiTLZero sSetting = "iTLZero" Case eiLocale sSetting = "Locale" Case eiAM sSetting = "s1159" Case eiPM sSetting = "s2359" Case eiCountryName sSetting = "sCountry" Case eiCurrencySymbol sSetting = "sCurrency" Case eiDateSeperator sSetting = "sDate" Case eiDecimal sSetting = "sDecimal" Case eiLanguage sSetting = "sLanguage" Case eiList sSetting = "sList" Case eiLongDate sSetting = "sLongDate" Case eiShortDate sSetting = "sShortDate" Case eiThousand sSetting = "sThousand" Case eiTimeSeperator sSetting = "sTime" Case eiTimeFormat sSetting = "sTimeFormat" Case eiTimePrefix sSetting = "iTimePrefix" Case eiMonDecimalSep sSetting = "sMonDecimalSep" Case eiMonThousandSep sSetting = "sMonThousandSep" Case eiNegNumber sSetting = "iNegNumber" Case eiNativeDigits sSetting = "sNativeDigits" Case eiNumShape sSetting = "NumShape" Case eiCalendarType sSetting = "iCalendarType" Case eiFirstDayOfWeek sSetting = "iFirstDayOfWeek" Case eiFirstWeekOfYear sSetting = "iFirstWeekOfYear" Case eiGrouping sSetting = "sGrouping" Case eiMonGrouping sSetting = "sMonGrouping" Case eiPositiveSign sSetting = "sPositiveSign" Case eiNegativeSign sSetting = "sNegativeSign" Case Else Debug.Print "Invalid Setting" Debug.Assert False End Select 'Retreive information from registry sValueName = "Control Panel\International" RegOpenKey HKEY_CURRENT_USER, sValueName, lhKey 'Determine the value type If RegQueryValueEx(lhKey, sSetting, 0, lValueType, ByVal 0, lDataBufSize) = ERROR_SUCCESS Then If lValueType = REG_SZ Then 'Create a buffer to hold the value sBuffer = String(lDataBufSize, 0) 'Get the value If RegQueryValueEx(lhKey, sSetting, 0, 0, ByVal sBuffer, lDataBufSize) = ERROR_SUCCESS Then 'Return the key value RegionSetting = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1) Else 'Return the default value RegionSetting = sDefault End If ElseIf lValueType = REG_BINARY Then If RegQueryValueEx(lhKey, sValueName, 0, 0, iValue, lDataBufSize) = ERROR_SUCCESS Then 'Return the key value RegionSetting = iValue Else 'Return the default value RegionSetting = sDefault End If End If Else 'Return the default value RegionSetting = sDefault End If 'Close the key RegCloseKey lhKey End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
