Seznam podporovan²ch znakov²ch sad

Public Const LOCALE_SLANGUAGE As Long = &H2  
Public Const LOCALE_SABBREVLANGNAME As Long = &H3
Public Const LCID_INSTALLED As Long = &H1  
Public Const LCID_SUPPORTED As Long = &H2  
Public Const LCID_ALTERNATE_SORTS As Long = &H4  

Public Declare Sub CopyMemory Lib "KERNEL32" _
   Alias "RtlMoveMemory"  (Destination As Any, _
   Source As Any, ByVal Length As Long)

Public Declare Function GetSystemDefaultLCID Lib "KERNEL32" () As Long

Public Declare Function GetLocaleInfo Lib "KERNEL32" _
   Alias "GetLocaleInfoA" (ByVal Locale As Long, _
   ByVal LCType As Long, ByVal lpLCData As String, _
   ByVal cchData As Long) As Long

Public Declare Function EnumSystemLocales Lib "KERNEL32" _
  Alias "EnumSystemLocalesA" (ByVal lpLocaleEnumProc As Long, _
   ByVal dwFlags As Long) As Long


Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, _
                                  ByVal dwLCType As Long) As String

   Dim sReturn As String
   Dim nSize As Long

   nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
    
   If nSize Then
      sReturn = Space$(nSize)
      nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
      If nSize Then
         GetUserLocaleInfo = Left$(sReturn, nSize - 1)
      End If
   End If
    
End Function


Public Function EnumSystemLocalesProc(lpLocaleString As Long) As Long

   Dim pos As Integer
   Dim dwLocaleDec As Long
   Dim dwLocaleHex As String
   Dim sLocaleName As String
   Dim sLocaleAbbrev As String
     
   dwLocaleHex = Space$(32)
   
   CopyMemory ByVal dwLocaleHex, lpLocaleString, ByVal Len(dwLocaleHex)
   
   pos = InStr(dwLocaleHex, Chr$(0))
   
   If pos Then
      dwLocaleHex = Left$(dwLocaleHex, pos - 1)
      dwLocaleHex = (Right$(dwLocaleHex, 4))
      dwLocaleDec = CLng("&H" & dwLocaleHex)
      sLocaleName = GetUserLocaleInfo(dwLocaleDec, LOCALE_SLANGUAGE)
      sLocaleAbbrev = GetUserLocaleInfo(dwLocaleDec,_
                    LOCALE_SABBREVLANGNAME)
   End If
   
   Form1.List1.AddItem "   " & dwLocaleHex & vbTab & _
                               dwLocaleDec & vbTab & _
                               sLocaleAbbrev & vbTab & _
                               sLocaleName
   
   EnumSystemLocalesProc = 1
   
End Function

Na formulß° p°idejte TextBox, ListBox a tlaΦφtko. Na udßlost Click tlaΦφtka:

Private Sub Command1_Click()

   Dim LCID As Long
   
   LCID = GetSystemDefaultLCID()
   
   Text1 = GetUserLocaleInfo(LCID, LOCALE_SLANGUAGE) & vbTab & _
           GetUserLocaleInfo(LCID, LOCALE_SABBREVLANGNAME)
   
  
   List1.AddItem "InstalovanΘ sady:"
   List1.AddItem "   hex" & vbTab & "dec" & vbTab & "abv" & vbTab & "sada"
   Call EnumSystemLocales(AddressOf EnumSystemLocalesProc, LCID_INSTALLED)
   
   
   List1.AddItem ""
   List1.AddItem "PodporovanΘ sady:"
   List1.AddItem "   hex" & vbTab & "dec" & vbTab & "abv" & vbTab & "sada"
   Call EnumSystemLocales(AddressOf EnumSystemLocalesProc, LCID_SUPPORTED)
   
End Sub

Zp∞t