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 f='./../../funktionsreferenzen/xprofan/new/'>NEW,24,0,1,0