XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Schriftarten-Auswahldialog erstellen und abfragen (2)
'(C) 2006 Andreas Hötker
'-Begin-----------------------------------------------------------------
'-ExternalFunctions---------------------------------------------------
Def @ChooseFont(1) !"COMDLG32.DLL", "ChooseFontA"
'-StructuresDefinition------------------------------------------------
Declare CHOOSEFONT#
Struct CHOOSEFONT = lStructSize&,
hWndOwner&,
hDC&,
lpLogFont&,
iPointSize&,
Flags&,
rgbColors&,
lCustData&,
lpfnHook&,
lpTemplateName&,
hInstance&,
lpszStyle&,
nFontType%,
Alignment%,
nSizeMin&,
nSizeMax&
Dim CHOOSEFONT#, CHOOSEFONT
Declare LOGFONT#
Struct LOGFONT = lfHeight&,
lfWidth&,
lfEscapement&,
lfOrientation&,
lfWeight&,
lfItalic#(1),
lfUnderline#(1),
lfStrikeOut#(1),
lfCharSet#(1),
lfOutPrecision#(1),
lfClipPrecision#(1),
lfQuality#(1),
lfPitchAndFamily#(1),
lfFaceName#(32)
Dim LOGFONT#, LOGFONT
'-ConstantsDefinition-------------------------------------------------
Def &CF_BOTH $3
Def &CF_EFFECTS $100
Def &CF_INITTOLOGFONTSTRUCT $40
Def &CF_LIMITSIZE $2000
Def &CF_PRINTERFONTS $2
Def &CF_SCREENFONTS $1
Def &CF_TTONLY $40000
'-Main----------------------------------------------------------------
LOGFONT#.lfHeight& = 1000/75
String LOGFONT#, 28 = "Arial" + @Chr$(0)

With CHOOSEFONT#

    .lStructSize& = @SizeOf(CHOOSEFONT#)
    .hWndOwner& = 0
    .lpLogFont& = LOGFONT#
    .Flags& = &CF_BOTH | &CF_TTONLY | &CF_INITTOLOGFONTSTRUCT |
    &CF_LIMITSIZE | &CF_EFFECTS
    .rgbColors& = @RGB(255, 0, 0)
    .nSizeMin& = 10
    .nSizeMax& = 14

EndWith

@ChooseFont(CHOOSEFONT#)
Window 100, 100 - 450, 300
Print "Schriftart " + @String$(LOGFONT#, 28) + " gewählt"
Print "mit einer Höhe von " + @Str$(CHOOSEFONT#.iPointSize& / 10)

If @or(CHOOSEFONT#.nFontType%,$100)=CHOOSEFONT#.nFontType%

    Print "fett"

endif

If @or(CHOOSEFONT#.nFontType%,$200)=CHOOSEFONT#.nFontType%

    Print "kursiv"

endif

If @Byte(LOGFONT#,21)=1

    Print "unterstrichen"

endif

If @Byte(LOGFONT#,22)=1

    Print "durchgestrichen"

endif

WaitKey
Dispose LOGFONT#
Dispose CHOOSEFONT#
'-End-------------------------------------------