Attribute VB_Name = "modCharSet"
Option Explicit
'
''Font enumeration types
'Public Const LF_FACESIZE = 32
'Public Const LF_FULLFACESIZE = 64
'
'Type LOGFONT
'  lfHeight As Long
'  lfWidth As Long
'  lfEscapement As Long
'  lfOrientation As Long
'  lfWeight As Long
'  lfItalic As Byte
'  lfUnderline As Byte
'  lfStrikeOut As Byte
'  lfCharSet As Byte
'  lfOutPrecision As Byte
'  lfClipPrecision As Byte
'  lfQuality As Byte
'  lfPitchAndFamily As Byte
'  lfFaceName(LF_FACESIZE - 1) As Byte
'End Type
'
'Type ENUMLOGFONTEX
'  elfLogFont As LOGFONT
'  elfFullName(LF_FULLFACESIZE - 1) As Byte
'  elfStyle(LF_FACESIZE - 1) As Byte
'  elfScript(LF_FACESIZE - 1) As Byte
'End Type
'
'Type NEWTEXTMETRIC
'  tmHeight As Long
'  tmAscent As Long
'  tmDescent As Long
'  tmInternalLeading As Long
'  tmExternalLeading As Long
'  tmAveCharWidth As Long
'  tmMaxCharWidth As Long
'  tmWeight As Long
'  tmOverhang As Long
'  tmDigitizedAspectX As Long
'  tmDigitizedAspectY As Long
'  tmFirstChar As Byte
'  tmLastChar As Byte
'  tmDefaultChar As Byte
'  tmBreakChar As Byte
'  tmItalic As Byte
'  tmUnderlined As Byte
'  tmStruckOut As Byte
'  tmPitchAndFamily As Byte
'  tmCharSet As Byte
'  ntmFlags As Long
'  ntmSizeEM As Long
'  ntmCellHeight As Long
'  ntmAveWidth As Long
'End Type
'
''ntmFlags field flags
'Public Const NTM_REGULAR = &H40&
'Public Const NTM_BOLD = &H20&
'Public Const NTM_ITALIC = &H1&
'
''tmPitchAndFamily flags
'Public Const TMPF_FIXED_PITCH = &H1
'Public Const TMPF_VECTOR = &H2
'Public Const TMPF_DEVICE = &H8
'Public Const TMPF_TRUETYPE = &H4
'Public Const ELF_VERSION = 0
'Public Const ELF_CULTURE_LATIN = 0
'
''EnumFonts Masks
'Public Const RASTER_FONTTYPE = &H1
'Public Const DEVICE_FONTTYPE = &H2
'Public Const TRUETYPE_FONTTYPE = &H4
'
'' Charset constants
'Public Const ANSI_CHARSET = 0
'Public Const DEFAULT_CHARSET = 1
'Public Const SYMBOL_CHARSET = 2
'Public Const SHIFTJIS_CHARSET = 128
'Public Const HANGEUL_CHARSET = 129
'Public Const GB2312_CHARSET = 134
'Public Const CHINESEBIG5_CHARSET = 136
'Public Const OEM_CHARSET = 255
'Public Const JOHAB_CHARSET = 130
'Public Const HEBREW_CHARSET = 177
'Public Const ARABIC_CHARSET = 178
'Public Const GREEK_CHARSET = 161
'Public Const TURKISH_CHARSET = 162
'Public Const THAI_CHARSET = 222
'Public Const EASTEUROPE_CHARSET = 238
'Public Const RUSSIAN_CHARSET = 204
'
'Public Const MAC_CHARSET = 77
'Public Const BALTIC_CHARSET = 186
'
'Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" _
'  (ByVal hDC As Long, ByVal lpszFamily As String, _
'   ByVal lpEnumFontFamProc As Long, lParam As Any) As Long
'Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" _
'  (ByVal hDC As Long, lpLogFont As LOGFONT, _
'   ByVal lpEnumFontProc As Long, ByVal lParam As Any, _
'   ByVal dw As Long) As Long
'
'Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
'Declare Function ReleaseDC Lib "user32" _
'   (ByVal hwnd As Long, ByVal hDC As Long) As Long
'
'Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, _
'                         ByVal FontType As Long, lParam As ListBox) As Long
'Dim FaceName As String
'
'  If lpNLF.lfCharSet <> SYMBOL_CHARSET Then
'    'convert the returned string from UniCode to ANSI
'     FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
'
'    'add the font to the list
'     lParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
'     ' Store default charset
'     lParam.ItemData(lParam.NewIndex) = lpNLF.lfCharSet
'  End If
'
'  'return success to the call
'  EnumFontFamProc = 1
'End Function
'
'Public Function EnumFontCharsets(ByVal lHDC As Long, _
'        cb As ComboBox, _
'        ByVal sFaceName As String _
'    ) As Long
'Dim tLF As LOGFONT
'Dim i As Integer
'
'  SetRedraw cb, False
'  cb.Clear
'
'  ' Get the fonts:
'  Dim hDC As Long
'  'get the handle to the device context of the list to fill
'  hDC = GetDC(cb.hwnd)
'
'  ' Convert the face name into a byte array:
'  If Len(sFaceName) > 0 Then
'    For i = 1 To Len(sFaceName)
'      tLF.lfFaceName(i - 1) = Asc(Mid$(sFaceName, i, 1))
'    Next i
'  End If
'  tLF.lfCharSet = DEFAULT_CHARSET
'
'  ' Start the enumeration:
'  EnumFontCharsets = EnumFontFamiliesEx(hDC, tLF, AddressOf EnumFontFamExProc, cb, 0)
'
'  'free the device context handle
'  ReleaseDC cb.hwnd, hDC
'  SetRedraw cb, True
'End Function
'
'Public Function EnumFontFamExProc(ByVal lpelfe As Long, ByVal lpntme As Long, ByVal iFontType As Long, ByVal lParam As ComboBox) As Long
'' The callback function for EnumFontFamiliesEx.
'
'' lpelf points to an ENUMLOGFONTEX structure, lpntm points to either
'' a NEWTEXTMETRICEX (if true type) or a TEXTMETRIC (non-true type)
'' structure.
'
'Dim tLFEx As ENUMLOGFONTEX
'Dim sFace As String, sScript As String
'Dim sStyle As String, sFullName As String
'Dim lPos As Long
'Dim sItem As String
'
'    CopyMemory tLFEx, ByVal lpelfe, LenB(tLFEx) ' Get the ENUMLOGFONTEX info
'
'' ' Only display printer and true type fonts:
'' If Not (m_bPrinterFont) Then
'' If (iFontType And TRUETYPE_FONTTYPE) <> TRUETYPE_FONTTYPE Then
'' EnumFontFamExProc = 1
'' Exit Function
'' End If
'' End If
'
'' ' Face Name
'' sFace = StrConv(tLFEx.elfLogFont.lfFaceName, vbUnicode)
'' lPos = InStr(sFace, Chr$(0))
'' If (lPos > 0) Then sFace = Left$(sFace, (lPos - 1))
'
'' ' mbShowStyle
'' If mbShowStyle = True Then
'' ' Style
'' sStyle = StrConv(tLFEx.elfStyle, vbUnicode)
'' lPos = InStr(sStyle, Chr$(0))
'' If (lPos > 0) Then sStyle = Left$(sStyle, (lPos - 1))
'' Else
'' sStyle = ""
'' End If
'
'    ' Script
'    sScript = StrConv(tLFEx.elfScript, vbUnicode)
'    lPos = InStr(sScript, Chr$(0))
'    If (lPos > 0) Then sScript = Left$(sScript, (lPos - 1))
'
'    If Not ExistsComboValue(lParam, sScript) Then
'      'add the font to the list
'      lParam.AddItem sScript
'      ' Store default charset
'      lParam.ItemData(lParam.NewIndex) = tLFEx.elfLogFont.lfCharSet
'    End If
'
'    ' Ask for more fonts:
'    EnumFontFamExProc = 1
'
'End Function
'
'Public Function ExistsComboValue(cb As ComboBox, Value As String) As Boolean
'Dim i As Long, lcValue As String
'
'  lcValue = LCase$(Value)
'
'  For i = 0 To cb.ListCount - 1
'
'    If LCase$(Value) = LCase$(cb.List(i)) Then
'      ExistsComboValue = True
'      Exit Function
'    End If
'
'  Next i
'
'End Function


