?
Solved

Override regional settings in VB6

Posted on 2006-05-08
5
Medium Priority
?
4,045 Views
Last Modified: 2011-10-03
Need functions such as CDate etc to use Regional settings other than those in the current locale settings but I don't want to change the system settings.

i.e. Date seperator on the local pc is "." (Germany) but I want the VB code to use "/" (English) as the date seperator.

While other languages (VB.net, Delphi) will allow the locale settings to be overwritten within tha application I can't find any method to do this in VB6.

Note: While aware of how to read and change the system regional settings within VB6 I only want to change them for this specific applications, I don't want to affect other applications running on this PC.  

Thanks
0
Comment
Question by:DeclanFee
  • 2
  • 2
5 Comments
 
LVL 9

Expert Comment

by:pradapkumar
ID: 16630754
you can simply use the following line to get english date

strEngDate = Format(Date, "dd/mm/yyyy")

To get Time as you wish

strCurTime = Format(Time,"hh:mm:ss")

thats all.
It won't affect the system settings and other applications.
0
 

Author Comment

by:DeclanFee
ID: 16631169
pradapkumar, Thanks for the comment, unfortunately my problem is a bit more complex than this. I have the source code for a large 3rd party app that I need to run on both german and English locale PCs. The app passes data in XML format to components on a shared server (English locale). The local client PC also read default values from config files which have all values in English locale date and numeric format such as "9,999,999.99" as opposed to German format "9.999.999,99"   -  I want to avoid significant redevelopment work. I'm happy to force users on both locales to enter data in English format ( "." as decimal seperator,  "," as thousand seperator etc.) but I need to force the locale aware functions in VB to use "," as the thousand seperator, "." as the decimal seperator and "/" as the date seperator despite the system locale settings being different.

Perhaps this isn't possible in VB6 in which case I'd have to persue other options.

Cheers
0
 
LVL 22

Expert Comment

by:danaseaman
ID: 16632954
You can do this in your app using following code. It relies heavily on API and you can use any supported Locale(LCID) you want:
http://www.cyberactivex.com/download/InternationalLocales.zip

The formatting code is in class Locale.cls where you set the Locale(LCID) and then format your numbers, dates, etc. using a user specified LCID independent of the Regional Settings.

If you need help with any of this let me know.
0
 
LVL 22

Accepted Solution

by:
danaseaman earned 1000 total points
ID: 16634196
To read config files in your app and ensure correct numeric and date vars you will also need to use code something like this(Function  ResolveDate and  Function ResolveNumber):

Option Explicit

Public Enum DateOrderEnum
   doDefault 'Your locale setting
   doMDY     'Month-Day-Year (U.S.)
   doDMY     'Day-Month-Year (EU, S.A.)
   doYMD     'Year-Month-Day (Japan)
End Enum

Public Const LOCALE_SSHORTDATE As Long = &H1F
Public Const LOCALE_STHOUSAND As Long = &HF
Public Const LOCALE_SDECIMAL  As Long = &HE

Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Public Function GetThousandsSep() As String
   GetThousandsSep = pfGLI(GetUserDefaultLCID(), LOCALE_STHOUSAND)
End Function

Public Function GetDecimalSep() As String
   GetDecimalSep = pfGLI(GetUserDefaultLCID(), LOCALE_SDECIMAL)
End Function

'Purpose: Assume a date string with English separator "1/4/2006"
'Returns: Correct Date Variable
Public Function ResolveDate(ByVal sDate As String) As Date
   Dim sArray() As String
   If InStr(sDate, "/") Then 'Potentially a date string
      sArray = Split(sDate, "/")
      Debug.Print "GetUserDefaultLCID", GetUserDefaultLCID
      Debug.Print "GetSystemDefaultLCID", GetSystemDefaultLCID
      If UBound(sArray) = 2 Then 'We have 3 parts
         Select Case ShortDateOrder2
            Case doMDY '
               ResolveDate = DateSerial(sArray(2), sArray(0), sArray(1))
            Case doDMY
               ResolveDate = DateSerial(sArray(2), sArray(1), sArray(0))
            Case doYMD
               ResolveDate = DateSerial(sArray(0), sArray(1), sArray(2))
         End Select
      End If
   End If
End Function

'Purpose: Assume a number string with English separators "123,456.78"
'Returns: Correct Double Variable
Public Function ResolveNumber(ByVal sNum As String) As Double
   Dim sTS As String
   Dim sDS As String
   sTS = GetThousandsSep
   sDS = GetDecimalSep
   
   If (sTS = ",") And (sDS = ".") Then 'English
      'format is OK
   Else
      Dim i As Long
      Dim sMid As String
      For i = 1 To Len(sNum)
         Select Case Mid(sNum, i, 1)
            Case ","
               Mid(sNum, i, 1) = sTS
            Case "."
               Mid(sNum, i, 1) = sDS
         End Select
      Next
   End If
   
   ResolveNumber = CDbl(sNum)
   
End Function

Public Function ShortDateOrder2() As DateOrderEnum
   'Get ShortDateOrder the hard way
   Dim sShort           As String
   Dim qOn              As Boolean
   Dim i                As Integer
   Dim sChar            As String

   On Error Resume Next

   'Get the Short Date format
   sShort = pfGLI(GetUserDefaultLCID(), LOCALE_SSHORTDATE)

   For i = 1 To Len(sShort)
      sChar = Mid(sShort, i, 1)
      'Ignore items in single quotes (if any)
      If sChar = "'" Then
         qOn = Not qOn
      Else
         If Not qOn Then
            Select Case sChar
               Case "d"
                  ShortDateOrder2 = doDMY
                  Exit Function
               Case "m"
                  ShortDateOrder2 = doMDY
                  Exit Function
               Case "y"
                  ShortDateOrder2 = doYMD
                  Exit Function
            End Select
         End If
      End If
   Next
End Function

Private Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
   Dim Buffer As String * 255
   GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
   pfGLI = StripNull(Buffer)
End Function

Public Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function

0
 

Author Comment

by:DeclanFee
ID: 16637630
Danaseaman, thanks for your post, looks like exactly what I need to resolve my problem. Will review code fully and get back to you later today. Thanks
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question