XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Schriftauswahldialog aufrufen und abfragen
Lauffähig ab Profan-Version 5.0
********************************
Flags CHOOSEFONT
CF_SCREENFONTS	$00000001	Nur Bildschirmfonts
CF_PRINTERFONTS 	$00000002	Nur Fonts die der Drucker verwenden kann
CF_SHOWHELP 	        $00000004L	Der Hilfe Button wird angezeigt. HWNDOwner > 0
CF_ENABLEHOOK       	$00000008L	Ermöglicht die Benutzung einer Hookfunktion.
CF_ENABLETEMPLAT	$00000010L	Es eine selbstdifiniert Dialogbox zu benutzen werden
CF_ENABLETEMPLATEHANDLE $00000020L	Der HInstance Eintrag enthält das Handle einer Dialogboxresource.
CF_INITTOLOGFONTSTRUCT  $00000040L	Die Dialogboxfunktion benutzt eine Logfont Struktur.
CF_USESTYLE		$00000080L	Der Benutzer kann auch den verwendeten Schriftstil bestimmen.
CF_EFFECTS		$00000100L	Die Dialogbox zeigt auch Auswahlmöglichkeiten für Durchgestrichen, Unterstrichen Text und Textfarben an.
CF_APPLY		$00000200L	Der Anwenden / Beutzen Button wird daregstell.
CF_ANSIONLY		$00000400L	Verwendet nur ANSI-Fonts keine Symbolfonts.
CF_NOVECTORFONTS	$00000800L	Es werden keine OEM-Fonts und Vertorfonts angezeigt.
CF_NOSIMULATIONS	$00001000L	Es wird keine Schriftprobe angezeigt.
CF_LIMITSIZE		$00002000L	Der Benutzer kann nur Schriftgrößen auswählen die im Bereichen zwischen nSizeMin + nSizeMax liegen.
CF_FIXEDPITCHONLY	$00004000L	Die Dialogbox zeigt nur Monospace-Fonts an.
CF_WYSIWYG		$00008000L	Es werden nur Fonts angezeigt die auf dem Bildschirm und Drucker gleich aussehen bzw. verwendet werden können.
CF_FORCEFONTEXIST	$00010000L	Die Dialgogbox gibt eine Fehlermeldung aus wenn der Benutzer Attribute auswählt die nicht miteinander kombinierbar sind.
CF_SCALABLEONLY	$00020000L	Es werden nur skallierbare Fonts angezeigt.
CF_TTONLY		$00040000L	Es werden nur True-Type Fonts angezeigt.
CF_NOFACESEL		$00080000L	Es kein Font selektiert wenn sich die Dialogbox öffnet. Es besteht die Möglichkeit der Mehrfachselektion.
CF_NOSTYLESEL		$00100000L	Der benutzer kann keinen Schrifstil einstellen. Muß bei Mehrfachselektion gesetzt werden.
CF_NOSIZESEL		$00200000L	Der Bentzer kann die Schriftgröße nicht einstellen.
Flags SCHRIFTSTIL (FONTType)
SIMULATED_FONTTYPE	$8000	Der Font wird vom GDI Simuliert. Kann nicht mit CF_NOSIMULATION verwendet werden.
PRINTER_FONTTYPE	$4000	Der verwendete Font ist ein Druckerfont.
SCREEN_FONTTYPE	$2000	Der verwendete Font ist eine Bildschirmschrift.
BOLD_FONTTYPE		$0100	Die Schrift ist Fettschrift.
ITALIC_FONTTYPE	$0200	Die Schrift wir Cursiv dargestellt.
REGULAR_FONTTYPE	$0400	Die verwendete Schrift ist weder Fett noch Cursiv. Nur bei True-Type Fonts möglich.
*****************************
Def ApiChooseFont(1) ! COMDLG32.DLL,ChooseFontA,#,%
Def APICommDlgExtendedError(0) ! COMDLG32.DLL,CommDlgExtendedError,,&
settruecolor 1
declare choosefont#,logfont#,text$
declare hoehe%,font$,kursiv%,underline%,fat%
dim logfont#,80 -> muss gross genug sein, da sonst der NAME gekürzt wird !
Long logfont#,0=div(2200,75) FONTHeight 1000 entspricht 10
Long logfont#,4=20           FONTWidth  1000 entspricht 10
Long logfont#,8=0
Long logfont#,12=200         FONTOrientation
Long logfont#,16=400         FONTWeight - bis 400 ist normal, alles drüber heisst fett !
String logfont#,20=        Italic
String logfont#,21=        Underline
String logfont#,22=        StrikeOut
String logfont#,23=0       CharSet
String logfont#,24=T       OutPrecision
String logfont#,25=T       ClipPrecision
String logfont#,26=0       Quality
String logfont#,27=2       PitchAndFamily
String logfont#,28=Arial   FaceName
Dim choosefont#,60
Long choosefont#,0 = 60 		Länge der Strukturvariable
Long choosefont#,4 = %hwnd 		Handle des Hauptfensters
Long choosefont#,8 = 0          	Instance-Handle des Hauptfensters
Long choosefont#,12= logfont# 		LogFontStruktur
Long choosefont#,16 = 0 		Pointsize
Long choosefont#,20 = $00002341 	Flags
Long choosefont#,24 = rgb(0,0,0) 	RGB - Voreinstellung und Wert der ausgelesen wird
Long choosefont#,28 = 0 		Custdata
Long choosefont#,32 = 0 		Hook
long choosefont#,36=  0 		Templatename
Long choosefont#,40=  0 		Hinstance
long choosefont#,44=  0 		Lpszstyle
Long choosefont#,48=  $00000001 	FONTtype
Long choosefont#,52=  12 		FONTSizeMin
Long choosefont#,56=  36		FONTSizeMax
cls
Decimals 0
apichoosefont(choosefont#)
Print APICommDlgExtendedError(),  <- Fehlerrückgabe der Dialogbox , bei 0 ist alles glattgegangen
Print @String$(logfont#,28),  <- FontName
Print Div(@Long(choosefont#,16),10),  <- Groesse
Farbe auslesen
Print @GetRValue(@long(choosefont#,24)),
@GetGValue(@long(choosefont#,24)),
@GetBValue(@long(choosefont#,24)),  <- Textfarbe RGB
Attribute auslesen
Let Hoehe%=div(@word(choosefont#,16),10)
Let Font$=@string$(logfont#,28)
Let Kursiv%=@Ord(@string$(logfont#,20))
Let Underline%=@Ord(@string$(logfont#,21))
Let Fat%=@Long(logfont#,16)

if gt(Fat%,400) then

    Let Fat%=1

else

    let Fat%=0

endif

let text$= Beispieltext zur Überprüfung
Usefont font$,hoehe%,0,fat%,kursiv%,underline%
Textcolor @rgb(@GetRValue(@long(choosefont#,24)),@GetGValue(@long(choosefont#,24)),@GetBValue(@long(choosefont#,24))),-1
drawtext 100,100,text$
waitinput
Dispose Choosefont#
Dispose Logfont#
end