Search code examples
vb6localecharacter-encodinglcid

What is the best way to determine the correct Charset for a given LCID at runtime in VB6?


I am displaying Japanese characters in a VB6 application with the system locale set to Japan and the language for non Unicode programs as Japanese. A call to GetACP() correctly returns 932 for Japanese. When I insert the Japanese strings into my controls they display as “ƒAƒtƒŠƒJ‚Ì—‰¤” rather than “アフリカの女王”. If I manually set the Font.Charset to 128 then they display correctly.

What is the best way to determine the correct Charset for a given LCID in VB6?


Solution

  • Expanding Bob's answer, here's some code to get the current default charset.

    Private Const LOCALE_SYSTEM_DEFAULT As Long = &H800
    Private Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004
    Private Const TCI_SRCCODEPAGE = 2
    
    Private Type FONTSIGNATURE
        fsUsb(4) As Long
        fsCsb(2) As Long
    End Type
    
    Private Type CHARSETINFO
        ciCharset As Long
        ciACP As Long
        fs As FONTSIGNATURE
    End Type
    
    Private 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
    
    Private Declare Function TranslateCharsetInfo Lib "GDI32" ( _
        lpSrc As Long, _
        lpcs As CHARSETINFO, _
        ByVal dwFlags As Long _
    ) As Long
    
    Public Function GetCharset() As Long
    On Error GoTo ErrorHandler
    
        Dim outlen As Long
        Dim lCodepage As Long
        Dim outBuffer As String
        Dim cs As CHARSETINFO
    
        outBuffer = String$(10, vbNullChar)
        outlen = GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_IDEFAULTANSICODEPAGE, outBuffer, Len(outBuffer))
    
        If outlen > 0 Then
            lCodepage = val(Left$(outBuffer, outlen - 1))
    
            If TranslateCharsetInfo(ByVal lCodepage, cs, TCI_SRCCODEPAGE) Then
                GetCharset = cs.ciCharset
            End If
        End If
    
        Exit Function
    
    ErrorHandler:
        GetCharset = 0
    End Function