XProfan

Source wurde al 15.07.2007 de el MMJ-Quellcodesammlung (Dietmar Horn) en el Babyklappe en XProfan.Com abgelegt:
Schriftauswahldialog aufrufen y abfragen
Lauffähig de Profano-Versión 5.0
********************************
Flags CHOOSEFONT
CF_SCREENFONTS	$00000001	Nur Bildschirmfonts
CF_PRINTERFONTS 	$00000002	Nur Fonts el el Drucker uso kann
CF_SHOWHELP 	        $00000004L	Der Ayuda Button se muestra. HWNDOwner > 0
CF_ENABLEHOOK       	$00000008L	Ermöglicht el Benutzung uno Hookfunktion.
CF_ENABLETEMPLAT	$00000010L	Lo una selbstdifiniert Dialogbox a benutzen voluntad
CF_ENABLETEMPLATEHANDLE $00000020L	Der HInstance Eintrag enthält el Handle uno Dialogboxresource.
CF_INITTOLOGFONTSTRUCT  $00000040L	El Dialogboxfunktion benutzt una Logfont Struktur.
CF_USESTYLE		$00000080L	Der Benutzer kann auch el verwendeten Schriftstil bestimmen.
CF_EFFECTS		$00000100L	El Dialogbox zeigt auch Auswahlmöglichkeiten para Durchgestrichen, Unterstrichen Texto y Textfarben a.
CF_APPLY		$00000200L	Der Anwenden / Beutzen Button se daregstell.
CF_ANSIONLY		$00000400L	Verwendet sólo ANSI-Fonts no Symbolfonts.
CF_NOVECTORFONTS	$00000800L	Lo voluntad no OEM-Fonts y Vertorfonts muestra.
CF_NOSIMULATIONS	$00001000L	Lo se no Schriftprobe muestra.
CF_LIMITSIZE		$00002000L	Der Benutzer kann sólo Schriftgrößen auswählen el en el Bereichen zwischen nSizeMin + nSizeMax mentira.
CF_FIXEDPITCHONLY	$00004000L	El Dialogbox zeigt sólo Monospace-Fonts a.
CF_WYSIWYG		$00008000L	Lo voluntad sólo Fonts adecuado el en el Bildschirm y Drucker igual aussehen o verwendet voluntad puede.
CF_FORCEFONTEXIST	$00010000L	El Dialgogbox son una Fehlermeldung de si el Benutzer Atributos auswählt el no miteinander kombinierbar son.
CF_SCALABLEONLY	$00020000L	Lo voluntad sólo skallierbare Fonts muestra.
CF_TTONLY		$00040000L	Lo voluntad sólo True-Type Fonts muestra.
CF_NOFACESEL		$00080000L	Lo kein Font selektiert si se el Dialogbox öffnet. Lo besteht el Möglichkeit el Mehrfachselektion.
CF_NOSTYLESEL		$00100000L	Der benutzer kann no Schrifstil einstellen. Muß en Mehrfachselektion gesetzt se.
CF_NOSIZESEL		$00200000L	Der Bentzer kann el Schriftgröße no einstellen.
Flags SCHRIFTSTIL (FONTType)
SIMULATED_FONTTYPE	$8000	Der Font se vom GDI Simuliert. Kann no con CF_NOSIMULATION verwendet se.
PRINTER_FONTTYPE	$4000	Der verwendete Font es una Druckerfont.
SCREEN_FONTTYPE	$2000	Der verwendete Font es una Bildschirmschrift.
BOLD_FONTTYPE		$0100	El Schrift es Fettschrift.
ITALIC_FONTTYPE	$0200	El Schrift wir Cursiv dargestellt.
REGULAR_FONTTYPE	$0400	El verwendete Schrift es weder Fett todavía Cursiv. Nur en True-Type Fonts posible.
*****************************
Def ApiChooseFont(1) ! COMDLG32.DLL,ChooseFontA,#,%
Def APICommDlgExtendedError(0) ! COMDLG32.DLL,CommDlgExtendedError,,&
settruecolor 1
declarar choosefont#,logfont#,texto$
declarar hoehe%,font$,kursiv%,underline%,fat%
dim logfont#,80 -> muss gross genug ser, como sonst el NAME gekürzt se !
Largo logfont#,0=div(2200,75) FONTHeight 1000 entspricht 10
Largo logfont#,4=20           FONTWidth  1000 entspricht 10
Largo logfont#,8=0
Largo logfont#,12=200         FONTOrientation
Largo logfont#,16=400         FONTWeight - a 400 es 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
Largo choosefont#,0 = 60 		Longitud el Strukturvariable
Largo choosefont#,4 = %hwnd 		Handle des Hauptfensters
Largo choosefont#,8 = 0          	Instance-Handle des Hauptfensters
Largo choosefont#,12= logfont# 		LogFontStruktur
Largo choosefont#,16 = 0 		Pointsize
Largo choosefont#,20 = $00002341 	Flags
Largo choosefont#,24 = rgb(0,0,0) 	RGB - Voreinstellung y Valor el ausgelesen se
Largo choosefont#,28 = 0 		Custdata
Largo choosefont#,32 = 0 		Hook
long choosefont#,36=  0 		Templatename
Largo choosefont#,40=  0 		Hinstance
long choosefont#,44=  0 		Lpszstyle
Largo choosefont#,48=  $00000001 	FONTtype
Largo choosefont#,52=  12 		FONTSizeMin
Largo choosefont#,56=  36		FONTSizeMax
cls
Decimals 0
apichoosefont(choosefont#)
Imprimir APICommDlgExtendedError(),  <- Fehlerrückgabe el Dialogbox , en 0 es alles glattgegangen
Imprimir @String$(logfont#,28),  <- FontName
Imprimir Div(@Largo(choosefont#,16),10),  <- Groesse
Farbe auslesen
Imprimir @GetRValue(@long(choosefont#,24)),
@GetGValue(@long(choosefont#,24)),
@GetBValue(@long(choosefont#,24)),  <- Textfarbe RGB
Atributos auslesen
Let Hoehe%=div(@word(choosefont#,16),10)
Let Font$=@cadena$(logfont#,28)
Let Kursiv%=@Ord(@cadena$(logfont#,20))
Let Underline%=@Ord(@cadena$(logfont#,21))
Let Fat%=@Largo(logfont#,16)

if gt(Fat%,400) then

    Let Fat%=1

más

    let Fat%=0

endif

let texto$= Beispieltext a Ü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,texto$
waitinput
Disponer Choosefont#
Disponer Logfont#
end