[Source] Fonts richtig laden und überprüfen! [Windows OS]
Verfasst: 13.05.2021 12:40
LoadFont() kann unter Umständen unbrauchbar sein, da die Funktion einem nicht mitteilt
ob eine bestimmter Font wirklich unter Windows OS geladen werden konnte bzw. verfügbar ist.
Dies ist in der Hilfe auch so beschrieben.
Was also tun um herauszufinden ob der Font der Gewüschte ist oder nicht?
Edit: Sourcecode geändert!
Die Lösung:
Viel Spass 
ob eine bestimmter Font wirklich unter Windows OS geladen werden konnte bzw. verfügbar ist.
Dies ist in der Hilfe auch so beschrieben.
Was also tun um herauszufinden ob der Font der Gewüschte ist oder nicht?
Edit: Sourcecode geändert!
Die Lösung:
Code: Alles auswählen
EnableExplicit
;Function AllocFont() - How to correctly load and verify a Font on Windows OS!
;Author: Mijikai
Procedure.i FontCallback(*LogFont.LOGFONT,*TextMetric.TEXTMETRIC,FontType.i,*Name)
If PeekS(@*LogFont\lfFaceName[0]) = PeekS(*Name)
PokeS(*name,#Null$)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i AllocFont(Name.s,Height.i,Style.i = #Null)
Protected hdc.i
Protected lf.LOGFONT
Protected try.s
If Name
hdc = CreateCompatibleDC_(#Null)
If hdc
try = Name
lf\lfCharSet = #DEFAULT_CHARSET
EnumFontFamiliesEx_(hdc,@lf,@FontCallback(),@try,#Null)
DeleteDC_(hdc)
If try
ProcedureReturn #Null
EndIf
ProcedureReturn LoadFont(#PB_Any,Name,Height,Style)
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.i Main()
Protected font.i
font = AllocFont("Arial",32)
If font
Debug "Font loaded!"
FreeFont(font)
Else
Debug "Font could not be loaded!"
EndIf
ProcedureReturn #Null
EndProcedure
Main()
End
