Fonts mit Bold und Italic listen

Seit den letzten Updates hat die Wahl von Fonts stark geändert. Wer ein PopUp programmieren will, das nur Fonts enthält, die Regular, Bold, Italic und Bolditalic tatsächlich enthalten, bekommt mit ‘Hausmitteln’ einige Schwierigkeiten.

Klar, der normale Weg geht vom System zur Ausgabe, aber die andere Richtung kann auch dienen. Da es sich nur um einen Menuaufruf handelt, der nicht zeitkritisch ist, kann auch die folgende Methode dienlich sein (mit Hausmitteln)

Ein Picture wird mit einem Char gefüllt und dann alle Pixelwerte eines Y-Wertes in einen String verwandelt. Der Ort sollte etwas exzentrisch sein, damit Italic sicher unterschieden ist. Wenn alle 4 Strings unterschiedlich sind, funktionieren Italic, Bold und BoldItalic mit dem Font wie gehabt.

Ist dort notwendig, wo die Formatierung des Textes spezielle Signifikanz haben soll und ‘unmögliche’ Formatierungen ausgeschlossen werden müssen.


Function FontHasBoldAndItalic(fname as string) As Boolean

Var t as string =“A”
Var p() as Picture
Var g(3) as Graphics
Var rs(3) as RGBSurface
Var s(3) as string

for i as Integer = 0 to 3
p.add new picture(30, 30)
g(p.LastIndex) = p(p.LastIndex).Graphics
rs(p.LastIndex) = p(p.LastIndex).RGBSurface
g(p.LastIndex).DrawingColor = &c00000000
g(p.LastIndex).FontName = fname
g(p.LastIndex).FontSize = 40
next

g(0).Italic = false
g(0).Bold = false
g(0).DrawText(t, 2, g(0).FontAscent-3)
s(0) = “”
for i as Integer = 0 to 29
Var tmp as String = rs(0).Pixel(10, i).ToString
s(0) = s(0) + tmp.Left(4)
next

g(1).Italic = false
g(1).Bold = True
g(1).DrawText(t, 2, g(1).FontAscent-3)
s(1) = “”
for i as Integer = 0 to 29
Var tmp as String = rs(1).Pixel(10, i).ToString
s(1) = s(1) + tmp.Left(4)
next
if s(0) = s(1) then return false

g(2).Italic = True
g(2).Bold = false
g(2).DrawText(t, 2, g(2).FontAscent-3)
s(2) = “”
for i as Integer = 0 to 29
Var tmp as String = rs(2).Pixel(10, i).ToString
s(2) = s(2) + tmp.Left(4)
next
if s(1) = s(2) then return false
if s(0) = s(2) then return false

g(3).Italic = True
g(3).Bold = True
g(3).DrawText(t, 2, g(3).FontAscent-3)
s(3) = “”
for i as Integer = 0 to 29
Var tmp as String = rs(3).Pixel(10, i).ToString
s(3) = s(3) + tmp.Left(4)
next
if s(1) = s(3) then return false
if s(1) = s(2) then return false
if s(2) = s(3) then return false

return true

Hallo Karl, interessanter, kreativer Ansatz. Danke fürs Teilen.

Unter Windows11 scheint das (ich habe nur einen Emulator) unnötig zu sein, also:

Sub Open()

Var count as Integer = System.FontCount-1
for i as Integer = 0 to count
if TargetWindows then
me.AddRow system.FontAt(i)
me.RowTagAt(me.LastAddedRowIndex) = system.FontAt(i)
else
Var useIt as Boolean
useIt = FontHasBoldAndItalic(system.FontAt(i))
if useIt then
me.AddRow system.FontAt(i)
me.RowTagAt(me.LastAddedRowIndex) = system.FontAt(i)
end if
end if
next

End Sub