XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Farbauswahldialog anzeigen und abfragen (2)
-Begin----------------------------------------------------------- ------
-ExternalFunctions---------------------------------------------------
Def @Choosecolor(1) !COMDLG32.DLL, ChooseColorA
-StructuresDefinition------------------------------------------------
Declare Choosecolor#
Struct Tchoosecolor = Lstructsize&, Hwndowner&, Hinstance&,
Rgbresult&, Lpcustcolors&, Flags&, Lcustdata&, Lpfnhook&,
Lptemplatename&
Dim Choosecolor#, Tchoosecolor
-ConstantsDefinition-------------------------------------------------
Def &Cc_anycolor $100
Def &Cc_enablehook $10
Def &Cc_enabletemplate $20
Def &Cc_enabletemplatehandle $40
Def &Cc_fullopen $2
Def &Cc_preventfullopen $4
Def &Cc_rgbinit $1
Def &Cc_showhelp $8
Def &Cc_solidcolor $80
-VariablesDefinition-------------------------------------------------
Declare Udc&[15]
Declare Res$
-Main----------------------------------------------------------------
-Define UserColors-------------------------------------------------
Udc&[0] = @Rgb(255, 127, 255)
Udc&[1] = @Rgb(255, 127, 127)
Udc&[2] = @Rgb(127, 127, 127)
-------------------------------------------------------------------

With Choosecolor#

    .Lstructsize& = @Sizeof(Choosecolor#)
    .Hwndowner& = 0
    .Hinstance& = 0
    .Rgbresult& = @Rgb(0, 255, 0)
    .Lpcustcolors& = @Addr(Udc&[0])
    .Flags& = &Cc_fullopen | &Cc_anycolor | &Cc_rgbinit

Endwith

If @Choosecolor(Choosecolor#)

    Res$ = @Str$(Choosecolor#.Rgbresult&) +
    Res$ = Res$ + Rotanteil:  +
    @Str$(@Getrvalue(Choosecolor#.Rgbresult&)) +
    Res$ = Res$ + Grünanteil:  +
    @Str$(@Getgvalue(Choosecolor#.Rgbresult&)) +
    Res$ = Res$ + Blauanteil:  +
    @Str$(@Getbvalue(Choosecolor#.Rgbresult&))
    @Messagebox(Res$, Gewählte Farbe, 64)

Endif

Dispose Choosecolor#
-End-------------------------------------------------------------------
End