Fontauswahldialog erstellen und abfragen

'Fontauswahldialog erstellen und abfragen

Beitrag, 15.07.2007 23:40:

'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

Dies ist die Offlinevariante vom Thread [Fontauswahldialog erstellen und abfragen].