XProfan

Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur XProfan.Com abgelegt:
Schriftauswahldialog appel et abfragen
Lauffähig ab Profan-Version 5.0
********************************
Flags CHOOSEFONT
CF_SCREENFONTS	$00000001	seulement Bildschirmfonts
CF_PRINTERFONTS 	$00000002	seulement Fonts qui qui Drucker verwenden peux
CF_SHOWHELP 	        $00000004L	qui Aider Button wird angezeigt. HWNDOwner > 0
CF_ENABLEHOOK       	$00000008L	Ermöglicht qui Benutzung einer Hookfunktion.
CF_ENABLETEMPLAT	$00000010L	Es une selbstdifiniert Dialogbox trop benutzen volonté
CF_ENABLETEMPLATEHANDLE $00000020L	qui HInstance Eintrag contient cela Handle einer Dialogboxresource.
CF_INITTOLOGFONTSTRUCT  $00000040L	qui Dialogboxfunktion benutzt une Logfont Struktur.
CF_USESTYLE		$00000080L	qui Benutzer peux aussi den verwendeten Schriftstil bestimmen.
CF_EFFECTS		$00000100L	qui Dialogbox zeigt aussi Auswahlmöglichkeiten pour Durchgestrichen, Unterstrichen Text et Textfarben à.
CF_APPLY		$00000200L	qui Anwenden / Beutzen Button wird daregstell.
CF_ANSIONLY		$00000400L	Verwendet seulement ANSI-Fonts aucun Symbolfonts.
CF_NOVECTORFONTS	$00000800L	Es volonté aucun OEM-Fonts et Vertorfonts angezeigt.
CF_NOSIMULATIONS	$00001000L	Es wird aucun Schriftprobe angezeigt.
CF_LIMITSIZE		$00002000L	qui Benutzer peux seulement Schriftgrößen auswählen qui im Bereichen entre nSizeMin + nSizeMax liegen.
CF_FIXEDPITCHONLY	$00004000L	qui Dialogbox zeigt seulement Monospace-Fonts à.
CF_WYSIWYG		$00008000L	Es volonté seulement Fonts angezeigt qui sur dem Bildschirm et Drucker juste air ou verwendet volonté peut.
CF_FORCEFONTEXIST	$00010000L	qui Dialgogbox gibt une Fehlermeldung aus si qui Benutzer Attribute auswählt qui pas miteinander kombinierbar sommes.
CF_SCALABLEONLY	$00020000L	Es volonté seulement skallierbare Fonts angezeigt.
CF_TTONLY		$00040000L	Es volonté seulement True-Type Fonts angezeigt.
CF_NOFACESEL		$00080000L	Es ne...aucune Font selektiert si sich qui Dialogbox öffnet. Es besteht qui Possibilité qui Mehrfachselektion.
CF_NOSTYLESEL		$00100000L	qui benutzer peux keinen Schrifstil einstellen. Doit chez Mehrfachselektion gesetzt volonté.
CF_NOSIZESEL		$00200000L	qui Bentzer peux qui Schriftgröße pas einstellen.
Flags SCHRIFTSTIL (FONTType)
SIMULATED_FONTTYPE	$8000	qui Font wird vom GDI Simuliert. peux pas avec CF_NOSIMULATION verwendet volonté.
PRINTER_FONTTYPE	$4000	qui verwendete Font ist un Druckerfont.
SCREEN_FONTTYPE	$2000	qui verwendete Font ist une Bildschirmschrift.
BOLD_FONTTYPE		$0100	qui Schrift ist Fettschrift.
ITALIC_FONTTYPE	$0200	qui Schrift wir Cursiv dargestellt.
REGULAR_FONTTYPE	$0400	qui verwendete Schrift ist weder Fett encore Cursiv. seulement chez True-Type Fonts possible.
*****************************
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 son, là sonst qui 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 - jusqu'à 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
Faible choosefont#,60
Long choosefont#,0 = 60 		Longueur qui 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 et Wert qui 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#)
Imprimer APICommDlgExtendedError(),  <- Fehlerrückgabe qui Dialogbox , chez 0 ist alles glattgegangen
Imprimer @String$(logfont#,28),  <- FontName
Imprimer Div(@Long(choosefont#,16),10),  <- Groesse
la couleur auslesen
Imprimer @GetRValue(@long(choosefont#,24)),
@GetGValue(@long(choosefont#,24)),
@GetBValue(@long(choosefont#,24)),  <- Textfarbe RGB
Attribute auslesen
Laisser Hoehe%=div(@word(choosefont#,16),10)
Laisser Font$=@string$(logfont#,28)
Laisser Kursiv%=@Ord(@string$(logfont#,20))
Laisser Underline%=@Ord(@string$(logfont#,21))
Laisser Fat%=@Long(logfont#,16)

si gt(Fat%,400) then

    Laisser Fat%=1

d'autre

    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