XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Fontauswahldialog erstellen und abfragen
Def @Choosefont(1) ! COMDLG32.DLL,ChooseFontA
Declare Choosefont#,Logfont#,Buf#,Buf&,Fett%,Kursiv%,Unterstrichen%
Declare Font&
Settruecolor 1
Windowstyle 31
Windowtitle Fontauswahldialog
Window 0,0-640,440
Dim Logfont#,60
Dim Choosefont#,60
Dim Buf#,32
Clear Buf#
String Buf#,0=Standard
Clear Choosefont#
Long Choosefont#,0=60
Long Choosefont#,4=%Hwnd
Long Choosefont#,12=Logfont#
Long Choosefont#,20=$800 | $20000 | $400 | $80 | $100 | $40000 | $1 | $40 + $800000
Long Choosefont#,44=Buf#
Let Buf&=Buf#
Clear Logfont#
Long Logfont#,0=20
Long Logfont#,4=0
Long Logfont#,12=200
Long Logfont#,16=400
Byte Logfont#,20=1
Byte Logfont#,26=1
String Logfont#,28=Times New Roman
@Choosefont(Choosefont#)

If @Instr(KURSIV,@Upper$(@String$(Buf#,0)))>0

    Let Kursiv%=1

Endif

If @Instr(FETT,@Upper$(@String$(Buf#,0)))>0

    Let Fett%=1

Endif

If @Byte(Logfont#,21)=1

    Let Unterstrichen%=1

Endif

If @Byte(Logfont#,22)=1

    @Messagebox(Durchstreichen will ich heute nicht!,Hinweis,64)

Endif

Addstring Font=+@String$(Logfont#,28)
Addstring Höhe=+@Str$(@Long(Logfont#,0))
Addstring Breite=+@Str$(@Long(Logfont#,4))
Addstring Fett=+@Str$(Fett%)
Addstring Kursiv=+@Str$(Kursiv%)
Addstring Unterstrichen=+@Str$(Unterstrichen%)
Addstring Farbe=+@Str$(@Long(Choosefont#,24))
Usefont @String$(Logfont#,28),@Abs(@Long(Logfont#,0)),@Abs(@Long(Logfont#,4)),Fett%,Kursiv%,Unterstrichen%
Textcolor @Long(Choosefont#,24),@Rgb(255,255,255)
Drawtext 0,0,Hallo
@Listbox$(Das wurde gewählt:,1)
Dispose Logfont#
Dispose Choosefont#
Dispose Buf#

While 0=0

    Waitinput

Wend