XProfan

 $H Windows.ph
 $H Messages.ph
DEF &CF_APPLY $200
DEF &CF_SCREENFONTS 1
DEF &CF_PRINTERFONTS 2
DEF &CF_BOTH 3
DEF &CF_EFFECTS $100
DEF &CF_ENABLEHOOK $8
DEF &CF_INITTOLOGFONTSTRUCT $40
DEF &CF_LIMITSIZE $2000
DEF &CF_SHOWHELP $4
Konstanten für Font-Dialog-Handles
###########################################
DEF &Control_Effects 1072
DEF &Control_Effects_Color_Strikeout 1040
DEF &Control_Effects_Color_Underline 1041
DEF &Control_Effects_Color_Static 1091
DEF &Control_Effects_Color_Dropdown 1139
DEF &Control_Script_Static 1094
DEF &Control_Script_Dropdown 1140
DEF &Control_Sample 1073
DEF &Control_S_Static 1092
DEF &Control_Fontname_Static 1088
DEF &Control_Fontname_Combo 1136
DEF &Control_Fontstyle_Static 1089
DEF &Control_Fontstyle_Combo 1137
DEF &Control_Fontweight_Static 1090
DEF &Control_Fontweight_Combo 1138
DEF &Control_Button_Ok 1
DEF &Control_Button_Cancel 2
DEF &Control_Button_Apply 1026
DEF &Control_Button_Help 1038
###########################################
Struct LOGFONT =  lfHeight&,lfWidth&,lfEscapement&,lfOrientation&,lfWeight&,
lfItalic#(1),lfUnderline#(1),lfStrikeOut#(1),lfCharSet#(1),lfOutPrecision#(1),
lfClipPrecision#(1),lfQuality#(1),lfPitchAndFamily#(1),lfFaceName$(32)
Struct CHOOSEFONT = lStructSize&,hwndOwner&,hDC&,lpLogFont&,iPointSize&,Flags&,
rgbColors&,lCustData&,lpfnHook&,lpTemplateName&,hInstance&,
lpszStyle&,nFontType%,MISSING_ALIGNMENT%,nSizeMin&,nSizeMax&

Proc CFHookProc

    Parameters hdlg&,uiMsg&,wParam&,lParam&
    hier wird der Font-Dialog manipuliert
    Var Result& = 0

    Select uiMsg&

        Caseof ~WM_INITDIALOG

        Fenster vergrössern
        ~Movewindow(hdlg&,0,0,800,400,1)
        ein Icon in den Dialog malen
        Create("Icon",hdlg&,"A",370,140)
        ~SetWindowText(hdlg&,"Der Font-Dialog wurde manipuliert")
        Result& = 1

        Caseof ~WM_COMMAND

        Select LoWord(wParam&)

            Caseof &Control_Button_Help

            Hilfe-Button wurde gedrückt
            MessageBox("Hier gibt es keine Hilfe","Info",~MB_ICONINFORMATION | ~MB_SYSTEMMODAL)
            Result& = 1

            CaseOf &Control_Button_Apply

            Übernehmen-Button wurde gedrückt
            MessageBox("Nicht eingebaut","Info",~MB_ICONINFORMATION | ~MB_SYSTEMMODAL)
            Result& = 1

            Caseof &Control_Button_Ok

            Übernehmen-Button wurde gedrückt
            ~PostMessage(hdlg&,~WM_COMMAND,~IDABORT,0)
            Result& = 1

            Caseof &Control_Button_Cancel

            Abbrechen-Button wurde gedrückt
            ~PostMessage(hdlg&,~WM_COMMAND,~IDABORT,0)
            Result& = 1

        EndSelect

    EndSelect

    Return Result&

EndProc

Proc MyChooseFont

    Set("FastMode", 1)
    Var lf# = New(LOGFONT)
    ;Strukturen mit ein paar Voreinstellugnen füllen
    lf#.lfHeight& = 1000/75 Fonthoehe = 10 ist voreingestellt
    lf#.lfFaceName$ = "Arial"Arial ist voreingestellt
    Var cf# = New(CHOOSEFONT)
    cf#.lStructSize& = SizeOf(cf#)
    cf#.lpLogFont& = lf#
    cf#.flags& = &CF_BOTH | &CF_INITTOLOGFONTSTRUCT | &CF_LIMITSIZE | &CF_ENABLEHOOK | &CF_EFFECTS | &CF_SHOWHELP | &CF_APPLY
    cf#.rgbColors& = RGB(255,0,0)Farbe vorgeben
    cf#.nSizeMin& = 8minimale Fonthoehe
    cf#.nSizeMax& = 72maximale Fonthoehe
    cf#.lpfnHook& = ProcAddr("CFHookProc",4)Hook-Procedur setzen
    ;Dialog aufrufen
    External("comdlg32.dll","ChooseFontA",cf#)
    Dispose lf#
    Dispose cf#
    Set("FastMode", 0)

EndProc

cls
MyChoosefont()
waitinput