PDA

Vollständige Version anzeigen : Schriftartenskript


Gordon
16.05.2001, 16:09
Hallo an Alle,
ich setzt in VB6 mit dem CommonDialog eine Schrift und möchte zusätzlich das Schriftartenskript (Arabisch, Westlich, ...) setzten. Kann mir jemand mitteilen wie das funktioniert ?

Vielen Dank im vorraus.

Gordon

Stefan Kulpa
16.05.2001, 17:12
<font face="Verdana" size="2">Hallo,

das Problem ist, dass das Control nicht alle Schriftarten anzeigt.
Die Attribute Arabisch, Westlich etc. bezeichnen meines Wissens spezielle Font-Varianten, die eben nicht mit angezeigt werden; z.B.:

statt:</font>
<font face="Courier New" size="2">Times New Roman
Times New Roman CE
Times New Roman CYR
Times New Roman Greek
Times New Roman TUR</font>

wird lediglich:
<font face="Courier New" size="2">Times New Roman</font>

<font face="Verdana" size="2">angezeigt...

Eine mögliche Lösung ist ein eigener Schriftenauswahldialog, der alle Schriftarten anzeigt.
Der schnellste Weg, alle Schriftarten zu ermitteln, ist über das API zu realisieren.
Die folgende Beispiel-Methode ermittelt alle installierten Schriftarten:</font>

<PRE><FONT SIZE=1 FACE=Courier New><FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Sub</FONT> Test()

<FONT COLOR=#000080>Dim</FONT> vFonts() <FONT COLOR=#000080>As</FONT> Variant
<FONT COLOR=#000080>Dim</FONT> lResult <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, lCount <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lResult = GetFontList(vFonts, TRUETYPE_FONTTYPE)
<FONT COLOR=#000080>For</FONT> lCount = 0 <FONT COLOR=#000080>To</FONT> lResult
<FONT COLOR=#000080>Debug.Print</FONT> vFonts(lCount)
<FONT COLOR=#000080>Next</FONT>
<FONT COLOR=#000080>Erase</FONT> vFonts

<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Sub</FONT>

</FONT></PRE>

<font face="Verdana" size="2">Dazu ist es notwendig, den nachfolgenden Quellcode in einem Modul zu speichern:</font>

<PRE><FONT SIZE=1 FACE=Courier New><FONT COLOR=#000080>Option</FONT> <FONT COLOR=#000080>Explicit</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Enum</FONT> FONT_TYPES
VECTOR_FONTTYPE = &H0
RASTER_FONTTYPE = &H1
DEVICE_FONTTYPE = &H2
TRUETYPE_FONTTYPE = &H4
ALL_FONTTYPES = (-1)
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Enum</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Const</FONT> LF_FACESIZE <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = 32

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Type</FONT> LOGFONT
lfHeight <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lfWidth <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lfEscapement <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lfOrientation <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lfWeight <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
lfItalic <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfUnderline <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfStrikeOut <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfCharSet <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfOutPrecision <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfClipPrecision <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfQuality <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfPitchAndFamily <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
lfsFaceName(LF_FACESIZE) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Type</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Type</FONT> NEWTEXTMETRIC
tmHeight <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmAscent <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmDescent <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmInternalLeading <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmExternalLeading <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmAveCharWidth <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmMaxCharWidth <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmWeight <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmOverhang <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmDigitizedAspectX <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmDigitizedAspectY <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
tmFirstChar <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmLastChar <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmDefaultChar <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmBreakChar <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmItalic <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmUnderlined <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmStruckOut <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmPitchAndFamily <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
tmCharSet <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Byte</FONT>
ntmFlags <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
ntmSizeEM <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
ntmCellHeight <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
ntmAveWidth <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Type</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> GetDC <FONT COLOR=#000080>Lib</FONT> "user32" _
(<FONT COLOR=#000080>ByVal</FONT> hwnd <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> EnumFontFamilies <FONT COLOR=#000080>Lib</FONT> "gdi32" <FONT COLOR=#000080>Alias</FONT> _
"EnumFontFamiliesA" _
(<FONT COLOR=#000080>ByVal</FONT> hdc <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> lpszFamily <FONT COLOR=#000080>As String</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> lpEnumFontFamProc <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
lParam <FONT COLOR=#000080>As</FONT> Any) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> ReleaseDC <FONT COLOR=#000080>Lib</FONT> "user32" _
(<FONT COLOR=#000080>ByVal</FONT> hwnd <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> hdc <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> GetActiveWindow <FONT COLOR=#000080>Lib</FONT> "user32" () <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>

<FONT COLOR=#000080>Dim</FONT> g_lSelectedFontType <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#000080>Dim</FONT> g_lFontsCounter <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#808080><HR></FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Function</FONT> GetFontList(vFonts <FONT COLOR=#000080>As</FONT> Variant, _
<FONT COLOR=#000080>Optional</FONT> lFontType <FONT COLOR=#000080>As</FONT> FONT_TYPES = ALL_FONTTYPES) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Methode: | Alle Schriften ermitteln;</FONT>
<FONT COLOR=#008000>'// | benötigt Callback-Funktion EnumFontFamProc</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Parameter: | vFonts - Variant-(Array) für die Schriftnamen</FONT>
<FONT COLOR=#008000>'// | lFontType - zu ermittelnde Schriftkategorie</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Rückgabe: | s.o.</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Beispiel: | Alle TrueType-Schriften ermitteln</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Dim vFonts() As Variant</FONT>
<FONT COLOR=#008000>'// Dim lResult As Long, lCount As Long</FONT>
<FONT COLOR=#008000>'// lResult = GetFontList(vFonts, TRUETYPE_FONTTYPE)</FONT>
<FONT COLOR=#008000>'// For lCount = 0 To lResult</FONT>
<FONT COLOR=#008000>'// Debug.Print vFonts(lCount)</FONT>
<FONT COLOR=#008000>'// Next</FONT>
<FONT COLOR=#008000>'// Erase vFonts</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#000080>Dim</FONT> lhWnd <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#000080>Dim</FONT> hdc <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>

lhWnd = GetActiveWindow()
hdc = GetDC(lhWnd)
<FONT COLOR=#008000>'// ----------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Alle Schriften ermitteln</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------</FONT>
g_lSelectedFontType = lFontType
g_lFontsCounter = 0
<FONT COLOR=#000080>ReDim</FONT> vFonts(0 <FONT COLOR=#000080>To</FONT> 0)
EnumFontFamilies hdc, vbNullString, <FONT COLOR=#000080>AddressOf</FONT> EnumFontFamProc, vFonts
ReleaseDC lhWnd, hdc
<FONT COLOR=#008000>'// ----------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Rückgabewert für die Funktion weiterleiten</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------</FONT>
GetFontList = g_lFontsCounter

<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Function</FONT>
<FONT COLOR=#808080><HR></FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Function</FONT> EnumFontFamProc(lpNLF <FONT COLOR=#000080>As</FONT> LOGFONT, lpNTM <FONT COLOR=#000080>As</FONT> NEWTEXTMETRIC, <FONT COLOR=#000080>ByVal</FONT> FontType <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, vArray) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Callback-Funktion!</FONT>
<FONT COLOR=#008000>'// Diese Funktion muss sich in einem Modul befinden!</FONT>
<FONT COLOR=#008000>'// -----------------------------------------------------------------</FONT>
<FONT COLOR=#000080>Dim</FONT> sFaceName <FONT COLOR=#000080>As String</FONT>
sFaceName = StrConv(lpNLF.lfsFaceName, vbUnicode)
sFaceName = Left$(sFaceName, InStr(sFaceName, vbNullChar) - 1)
<FONT COLOR=#000080>If</FONT> Len(sFaceName) > 0 <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#000080>If</FONT> (g_lSelectedFontType = ALL_FONTTYPES) <FONT COLOR=#000080>Or</FONT> _
(g_lSelectedFontType = FontType) <FONT COLOR=#000080>Then</FONT>
g_lFontsCounter = g_lFontsCounter + 1
<FONT COLOR=#000080>ReDim</FONT> <FONT COLOR=#000080>Preserve</FONT> vArray(g_lFontsCounter)
vArray(g_lFontsCounter - 1) = sFaceName
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
EnumFontFamProc = 1

<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Function</FONT>
<FONT COLOR=#808080></FONT>

</FONT></PRE>
<font face="Verdana" size="2">
Das sieht zwar recht aufwendig aus, ist aber die schnellste Methode, die ich kenne - und bei Systemen mit vielen Schriftarten recht nützlich.

Gruß</font>

Gordon
16.05.2001, 19:07
Vielen Dank !
Das klappt wunderbar. Jetzt muss ich die ausgewählt Schrift einem Objekt wie zum Beispiel einem Label zuweisen. Hast du da vieleicht auch eine Idee ? Währe super.

Danke schonmal vorab.

Gruß Gordon

Stefan Kulpa
18.05.2001, 11:43
Hallo,

das geht durch die einfache Zuweisung:

z.B.:
Label1.FontName = "Times New Roman Greek"

Gruß, Stefan

Gordon
18.05.2001, 12:59
Das Problem bei mir ist das ich leider nicht alle Eingabegebiestschema auf meinem Rechner installiert habe. (und dei Tastatur Layouts)
Ich muß mal sehen wie das alles so noch klappt. Ich danke dir auf jeden fall für deine Mühe.

Gruß Gordon