Attribute VB_Name = "Fonts"
Option Explicit

'Modul nur da um die Fonts schnell zu laden
'Keine Änderungen nötig!

Private Const LF_FACESIZE = 32
Private Const LF_FULLFACESIZE = 64

Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hDC As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal lParam As Long, ByVal dw As Long) As Long

Private 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) As Byte

End Type

Private Type ENUMLOGFONTEX
    elfLogFont As LOGFONT
    elfFullName(LF_FULLFACESIZE) As Byte
    elfStyle(LF_FACESIZE) As Byte
    elfScript(LF_FACESIZE) As Byte

End Type

Private Const DEFAULT_CHARSET = 1
Private lstFonts As ListBox
Private cboFonts As ComboBox
Private LastFont As String

Public Sub GetAllFontsCombo(ByVal hDC As Long, cboBox As ComboBox)
    ' Alle Screen.fonts in Combobox einlesen
    Dim lf As LOGFONT
    Set cboFonts = cboBox
    
    cboFonts.Clear
    lf.lfCharSet = DEFAULT_CHARSET
    EnumFontFamiliesEx hDC, lf, AddressOf EnumFontFamExProcC, 0&, 0&
End Sub

Public Function EnumFontFamExProcL(ByRef lpElfe As ENUMLOGFONTEX, ByVal lpntme As Long, ByVal FontType As Long, ByVal lParam As Long) As Long
    ' Listbox
    Dim FaceName As String
    ByteArray2String lpElfe.elfLogFont.lfFaceName, FaceName

    If Not LastFont = FaceName Then lstFonts.AddItem FaceName
    LastFont = FaceName

    EnumFontFamExProcL = 1
End Function

Public Function EnumFontFamExProcC(ByRef lpElfe As ENUMLOGFONTEX, ByVal lpntme As Long, ByVal FontType As Long, ByVal lParam As Long) As Long
    ' Combobox
    Dim FaceName As String
    ByteArray2String lpElfe.elfLogFont.lfFaceName, FaceName
    
    If Not LastFont = FaceName Then cboFonts.AddItem FaceName
    LastFont = FaceName
    
    EnumFontFamExProcC = 1
End Function

Public Function ByteArray2String(ByteArray() As Byte, OutputString As String)
    ' Funktion für List und Combo
    Dim i As Long
    
    OutputString = ""
    For i = 0 To UBound(ByteArray)
        If ByteArray(i) = 0 Then Exit For
        OutputString = OutputString & Chr(ByteArray(i))
    Next i
End Function

Public Function InitSize(Typ As Control)
  Dim i As Double
  For i = 12 To 72 Step 4
  Typ.AddItem i
  Next i
End Function

