XProfan

Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) in The Babyklappe on XProfan.Com stored:
Schriftauswahldialog Call and inquire
executable ex Profan-Version 5.0
********************************
? Happen? CHOOSEFONT
CF_SCREENFONTS	$00000001	only Bildschirmfonts
CF_PRINTERFONTS 	$00000002	only Fonts The the printer use can
CF_SHOWHELP 	        $00000004L	The Help Button becomes displayed. HWNDOwner > 0
CF_ENABLEHOOK       	$00000008L	Ermöglicht The Benutzung of/ one Hookfunktion.
CF_ENABLETEMPLAT	$00000010L	it a selbstdifiniert Dialogbox To using go
CF_ENABLETEMPLATEHANDLE $00000020L	The HInstance entry contains the lever of/ one Dialogboxresource.
CF_INITTOLOGFONTSTRUCT  $00000040L	The Dialogboxfunktion using a Logfont structure.
CF_USESTYLE		$00000080L	The user can too whom verwendeten Schriftstil to determine.
CF_EFFECTS		$00000100L	The Dialogbox shows too Auswahlmöglichkeiten for Striked, Underlined Text and Textfarben on.
CF_APPLY		$00000200L	The utilize / Beutzen Button becomes daregstell.
CF_ANSIONLY		$00000400L	uses only ANSI-Fonts no Symbolfonts.
CF_NOVECTORFONTS	$00000800L	it go no OEM-Fonts and Vertorfonts displayed.
CF_NOSIMULATIONS	$00001000L	it becomes no Schriftprobe displayed.
CF_LIMITSIZE		$00002000L	The user can only Schriftgrößen select The in the reaches between nSizeMin + nSizeMax lie.
CF_FIXEDPITCHONLY	$00004000L	The Dialogbox shows only Monospace-Fonts on.
CF_WYSIWYG		$00008000L	it go only Fonts displayed The on the screen and printer same looks or. uses go can.
CF_FORCEFONTEXIST	$00010000L	The Dialgogbox gives a Error Message from if the user attributes selecting The not together kombinierbar are.
CF_SCALABLEONLY	$00020000L	it go only skallierbare Fonts displayed.
CF_TTONLY		$00040000L	it go only True-Type Fonts displayed.
CF_NOFACESEL		$00080000L	it no Font selektiert if itself The Dialogbox öffnet. it exists The Possibility the Mehrfachselektion.
CF_NOSTYLESEL		$00100000L	The user can none Schrifstil take on. mandatory with Mehrfachselektion staid be.
CF_NOSIZESEL		$00200000L	The Bentzer can The Schriftgröße not take on.
? Happen? SCHRIFTSTIL (FONTType)
SIMULATED_FONTTYPE	$8000	The Font becomes of GDI simulate. can not with CF_NOSIMULATION uses be.
PRINTER_FONTTYPE	$4000	The used Font is one Druckerfont.
SCREEN_FONTTYPE	$2000	The used Font is a Bildschirmschrift.
BOLD_FONTTYPE		$0100	The Font is Big-Font.
ITALIC_FONTTYPE	$0200	The Font we Cursiv displayed.
REGULAR_FONTTYPE	$0400	The used Font is weder Big yet Cursiv. only with 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$,italic%,underline%,fat%
dim logfont#,80 -> must tall enough his, there otherwise the NAME gekürzt becomes !
Long logfont#,0=div(2200,75) FONTHeight 1000 corresponds to 10
Long logfont#,4=20           FONTWidth  1000 corresponds to 10
Long logfont#,8=0
Long logfont#,12=200         FONTOrientation
Long logfont#,16=400         FONTWeight - To 400 is normal, everything drüber means big !
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 		length the Strukturvariable
Long choosefont#,4 = %hwnd 		lever the Mainwindow
Long choosefont#,8 = 0          	Instance-lever the Mainwindow
Long choosefont#,12= logfont# 		LogFontStruktur
Long choosefont#,16 = 0 		Pointsize
Long choosefont#,20 = $00002341 	? Happen?
Long choosefont#,24 = rgb(0,0,0) 	RGB - Default-Settings and worth the read becomes
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 the Dialogbox , with 0 is everything gone smoothly
Print @String $(logfont#,28),  <- FontName
Print Div(@Long(choosefont#,16),10),  <- Groesse
colour read
Print @GetRValue(@long(choosefont#,24)),
@GetGValue(@long(choosefont#,24)),
@GetBValue(@long(choosefont#,24)),  <- Textfarbe RGB
attributes read
Let Hoehe%=div(@word(choosefont#,16),10)
Let Font$=@string $(logfont#,28)
Let Italic%=@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 to Überprüfung
Usefont font$,hoehe%,0,fat%,italic%,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