XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Schrift-Auswahldialog
Lauffähig ab Profan-Version 5.0
geschrieben im Dezember 2003 - Horst Horn
kann von jederman benutzt oder verbessert werden
-----------------------------------------

PROC SCHRIFTEN_WAHL

    PROC SCHRIFT_FORMAT

        CLEARLIST
        Addstring  6
        Addstring  8
        AddString 10
        AddString 12
        AddString 14
        AddString 16
        AddString 18
        AddString 20
        AddString 22
        AddString 24
        AddString 26
        AddString 28
        AddString 30
        Addstring 34
        Addstring 36
        Addstring 40
        Addstring 44
        Addstring 50
        Addstring 54
        Addstring 60
        Addstring 64
        Addstring 70

    ENDPROC

    DECLARE win01&,txt$
    DECLARE font_list&,G_list&,F_E%,F_back%,F_OK%,nr%,auswahl%,font$
    DECLARE txt%,anz%,gross%,gross$,font0%,font00%
    DECLARE fett%,strich%,kursiv%
    DECLARE fett&,strich&,kursiv&
    PARAMETERS font$,gross$,fett%,kursiv%,strich%
    font0%=CREATE(FONT,ARIAL,16,6,0,0,0)
    txt$=Wählen Sie hier Schriftart und Grösse aus. Die Anzeige wird sofort aktualisiert.
    Mit [Auswahl übernehmen] kann dann die Schrift übernommen werden.
    ---------------------
    F_E%=0
    CLEARLIST
    WindowStyle 32
    win01&=CREATE(WINDOW,%HWnd, Schrift-Auswahl...,SUB(%MaxX,500),SUB(%MaxY,520),450,470)
    F_back%=CREATE(BUTTON,win01&,Abbrechen,10,5,100,25)
    SetFont F_back%,font0%
    F_OK%=CREATE(BUTTON,win01&,Auswahl übernehmen,260,5,175,25)
    SetFont F_OK%,font0%
    font_list&=CREATE(SORTEDLISTBOX,win01&,,10,35,175,250)
    SetFont font_list&,font0%
    ADDFONTS
    MoveListToList(font_list&)
    txt%=CREATE(TEXT,win01&,txt$,200,35,235,150)
    SetFont txt%,font0%
    G_list&=CREATE(LISTBOX,win01&,,210,120,50,145)
    SetFont G_list&,font0%
    fett&=CREATE(CHECKBOX,win01&, Fett,290,140,100,20)
    SetFont fett&,font0%
    Case fett%=1:SetCheck fett&,1
    kursiv&=CREATE(CHECKBOX,win01&, Kursiv,290,180,100,20)
    SetFont kursiv&,font0%
    Case kursiv%=1:SetCheck kursiv&,1
    strich&=CREATE(CHECKBOX,win01&, Unterstrichen,290,220,100,20)
    SetFont strich&,font0%
    Case strich%=1:SetCheck strich&,1
    SCHRIFT_FORMAT
    MoveListToList(G_list&)
    SetFont G_list&,font0%
    SelectString(font_list&,-1,font$)
    SelectString(G_list&,-1,gross$)
    txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
    font00%=CREATE(FONT,font$,gross$,0,fett%,kursiv%,strich%)
    SetFont txt%,font00%

    WhileNot F_E%

        WAITINPUT
        anz%=GETCURSEL(G_list&)
        gross$=GETSTRING$(G_list&,anz%)
        gross%=VAL(gross$)
        nr%=GETCURSEL(font_list&)
        font$=GetString$(font_list&,nr%)
        auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
        txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
        SetFont txt%,auswahl%

        IF GetCheck(fett&)=1:fett%=1

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ELSEIF GetCheck(fett&)=0:fett%=0

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ENDIF

        IF GetCheck(kursiv&)=1:kursiv%=1

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ELSEIF GetCheck(kursiv&)=0:kursiv%=0

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ENDIF

        IF GetCheck(strich&)=1:strich%=1

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ELSEIF GetCheck(strich&)=0:strich%=0

            auswahl%=CREATE(FONT,font$,gross%,0,fett%,kursiv%,strich%)
            txt%=CREATE(TEXT,win01&,Date$(2),10,290,400,135)
            SetFont txt%,auswahl%

        ENDIF

        If GetFocus(F_back%)

            DesTroyWindow(win01&)
            END

        ENDIF

        IF GetFocUs(F_OK%)

            print font$,gross%,0,fett%,kursiv%,strich% die Null steht für die Schriftbreite -
            die sollte man dem Font selbst überlassen (EXTRA-BREIT ist eine Band ;o)

        ENDIF

    WEND

ENDPROC

Aufruf mit Font, Grösse, Fett, kursiv, Unterstrichen
CLS
Schriften_Wahl COURIER NEW,24,0,1,0