Beitrag, 16.07.2007 01:28: ;createCode()'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össen 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. Muss bei Mehrfachselektion gesetzt werden.
' CF_NOSIZESEL $00200000L Der Bentzer kann die Schriftgrösse 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(),"
Dies ist die Offlinevariante vom Thread [Schriftauswahldialog aufrufen und abfragen].
©2006 XProfan.Com