XProfan

Source wurde al 15.07.2007 de el MMJ-Quellcodesammlung (Dietmar Horn) en el Babyklappe en XProfan.Com abgelegt:
Fontauswahldialog redactar y abfragen
Def @Choosefont(1) ! COMDLG32.DLL,ChooseFontA
Declarar Choosefont#,Logfont#,Buf#,Buf&,Fett%,Kursiv%,Unterstrichen%
Declarar Font&
Settruecolor 1
Windowstyle 31
Windowtitle Fontauswahldialog
Ventana 0,0-640,440
Dim Logfont#,60
Dim Choosefont#,60
Dim Buf#,32
Claro Buf#
String Buf#,0=Standard
Claro Choosefont#
Largo Choosefont#,0=60
Largo Choosefont#,4=%Hwnd
Largo Choosefont#,12=Logfont#
Largo Choosefont#,20=$800 | $20000 | $400 | $80 | $100 | $40000 | $1 | $40 + $800000
Largo Choosefont#,44=Buf#
Let Buf&=Buf#
Claro Logfont#
Largo Logfont#,0=20
Largo Logfont#,4=0
Largo Logfont#,12=200
Largo 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 voluntad Yo heute no!,Referencia,64)

Endif

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

Mientras que 0=0

    Waitinput

Wend