XProfan

Der Farbauswahldialog (in der Profan-Hilfe beschrieben)
um die Anzeige der Farbpalette erweitert.
 $P*
 $I C:PROFANLIBBILDBUTTON.INC (Für Bildbuttons/Iconbuttons)
 $I C:PROFANLIBSKCONTROL.INC (Für SKCONTROL.DLL)
 $H C:ProfanIncludeStructs.ph
Def @ChooseColor(1) !"COMDLG32.DLL", "ChooseColorA"
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
DEF GETWINDOW(2) !"USER32","GetWindow"
Set("ErrorLevel",0)
Set("TrueColor",1)
Set("Decimals",0)

Proc HexStr

    Parameters d&
    Declare h$
    h$ = Hex$(d&)
    Return "$" + MkStr$("0",6-Len(h$)) + h$

EndProc

PROC ShowPalette

    Parameters ausgewaehlt&
    DECLARE DLG&, DIALOGENDE%
    DECLARE SKCONTROL&,STRING#,SKIMAGE#,SKIMAGE2#,SKIMAGE3#,FONT&
    DECLARE GW_CHILD&
    LET GW_CHILD& = 5
    LET SKCONTROL& = USEDLL("C:PROFANLIBSKCONTROL.DLL")
    SKCTRL_INITDLL()
    DIM STRING#,500
    DIM SKIMAGE#,500
    DIM SKIMAGE2#,500
    DIM SKIMAGE3#,500
    LET FONT& = @CREATE("FONT","MS SANS SERIF",13,0,0,0,0)
    DECLARE GROUPBOX1&, GROUPBOX2&, addi&, IconDatei$, ICONBUTTON1&
    DECLARE T1a&[8], T1b&[8], T2a&[7], T2b&[7],SKC&[16]
    addi& = 190
    DLG& = CREATE("DIALOG",%HWND,"Folgende Farben wurden gewählt",22,20,383,424)
    USEFONT "MS Sans Serif",13,0,0,0,0
    SETDIALOGFONT 1
    GROUPBOX1& = @CREATE("GROUPBOX",DLG&,"",0000,0000,0186,0330)

    WhileLoop 0, 7

        T1a&[&loop] = @CREATE("TEXT",DLG&,"Farbe "+Str$(&loop)+":",11,11+(&loop*40),50,20)

    EndWhile

    WhileLoop 0, 7

        string string#,0 = Str$(&loop)
        LET SKC&[&loop] = SKCTRL_CREATECOLORBUTTON(DLG&,string#,RGB(255,255,0),RGB(0,0,255),71,11+(&loop*40),29,30,%hInstance)
        SETFONT SKC&[&loop],FONT& : SKCTRL_SETCOLOR(SKC&[&loop],1,0) : SKCTRL_SETCOLOR(SKC&[&loop],2,UDC&[&loop])

    EndWhile

    WhileLoop 0, 7

        T1b&[&loop] = @CREATE("TEXT",DLG&,HexStr(UDC&[&loop]),111,21+(&loop*40),60,20)

    EndWhile

    GROUPBOX2& = @CREATE("GROUPBOX",DLG&,"",0000+addi&,0000,0186,0330)

    WhileLoop 0, 7

        T2a&[&loop] = @CREATE("TEXT",DLG&,"Farbe "+Str$(&loop+8)+":",11+addi&,11+(&loop*40),50,20)

    EndWhile

    WhileLoop 0, 7

        string string#,0 = Str$(&loop+8)
        LET SKC&[&loop+8] = SKCTRL_CREATECOLORBUTTON(DLG&,string#,RGB(255,255,0),RGB(0,0,255),71+addi&,11+(&loop*40),29,30,%hInstance)
        SETFONT SKC&[&loop+8],FONT& : SKCTRL_SETCOLOR(SKC&[&loop+8],1,0) : SKCTRL_SETCOLOR(SKC&[&loop+8],2,UDC&[&loop+8])

    EndWhile

    WhileLoop 0, 7

        T2b&[&loop] = @CREATE("TEXT",DLG&,HexStr(UDC&[&loop+8]),111+addi&,21+(&loop*40),60,20)

    EndWhile

    ausgewaehlt&
    T1a&[8] = @CREATE("TEXT",DLG&,"letzte Auswahl:",11,340,80,15)
    string string#,0 = ":-)"
    LET SKC&[16] = SKCTRL_CREATECOLORBUTTON(DLG&,string#,RGB(255,255,0),RGB(0,0,255),90,349,29,30,%hInstance)
    SETFONT SKC&[16],FONT& : SKCTRL_SETCOLOR(SKC&[16],1,0) : SKCTRL_SETCOLOR(SKC&[16],2,ausgewaehlt&)
    T1b&[8] = @CREATE("TEXT",DLG&,HexStr(ausgewaehlt&),11,360,60,20)
    IconDatei$ = @FileSearch$("mspaint.exe", @GetEnv$("PATH"))
    ICONBUTTON "0",IconDatei$,DLG&,0170,0349,0040,0040
    LET ICONBUTTON1& = @&(0)
    SETFOCUS(DLG&)
    REPAINT
    LET DIALOGENDE% = 0

    WHILENOT DIALOGENDE%

        WAITINPUT

        If @EQU(%KEY,2) Or GETFOCUS(ICONBUTTON1&)

            LET DIALOGENDE%= 1

        ENDIF

    ENDWHILE

    @DESTROYWINDOW(DLG&)
    DISPOSE STRING#
    DISPOSE SKIMAGE#
    DISPOSE SKIMAGE2#
    DISPOSE SKIMAGE3#
    SKCTRL_DEINITDLL()
    FREEDLL SKCONTROL&
    DELETEOBJECT FONT&

ENDPROC

Set("AutoPaint",2)
Fenster wird für UseFont benötigt
WindowTitle "Farbpalette"
WindowStyle 112
Window 0,0 - 0,0
-StructuresDefinition------------------------------------------------
Declare CHOOSECOLOR#
Struct TCHOOSECOLOR = ~CHOOSECOLOR
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)
    ShowPalette CHOOSECOLOR#.rgbResult&

EndIf

Dispose CHOOSECOLOR#
-End-------------------------------------------------------------------
End