' Color chooser dialog example

$TYPECHECK ON

CONST CC_RGBINIT = &H1
CONST CC_FULLOPEN = &H2
CONST CC_PREVENTFULLOPEN = &H4
CONST CC_SHOWHELP = &H8
CONST CC_ENABLEHOOK = &H10
CONST CC_ENABLETEMPLATE = &H20
CONST CC_ENABLETEMPLATEHANDLE = &H40
CONST CC_SOLIDCOLOR = &H80
CONST CC_ANYCOLOR = &H100

TYPE TCHOOSECOLOR
    lStructSize AS LONG
    hWndOwner AS LONG
    hInstance AS LONG
    rgbResult AS LONG
    CustColors(1 TO 16) AS LONG
    Flags AS DWORD
    lCustData AS LONG
    lpfnHook AS LONG
    lpTemplateName AS LONG
END TYPE

DECLARE FUNCTION ChooseColorDlg LIB "COMDLG32" ALIAS "ChooseColorA" _
                 (CC AS TCHOOSECOLOR) AS LONG
Declare Function RealizePal Lib "gdi32" alias "RealizePalette" (ByVal hdc As Long) As Long 
Declare Function SelectPal Lib "gdi32" alias "SelectPalette" (ByVal hdc As Long, ByVal hPalette _
    As Long, ByVal bForceBackground As Long) As Long 


DECLARE SUB ButtonClick (Sender AS QBUTTON)


DIM CC AS TCHOOSECOLOR

'-- 16 of these custom colors, whatever you want...
    CC.CustColors(1) = &HFF0000
    CC.CustColors(2) = &H00FF00
    CC.CustColors(3) = &H0000FF
    CC.CustColors(4) = &HFF00FF
    CC.CustColors(5) = &H00FFFF
    CC.CustColors(6) = &HFFFFFF
    CC.CustColors(7) = &H559911
    CC.CustColors(8) = &HEE44BB
    CC.CustColors(9) = &HBB44EE
    CC.CustColors(10) = &H115599
    CC.CustColors(11) = &H333333
    CC.CustColors(12) = &H666666
    CC.CustColors(13) = &H999999
    CC.CustColors(14) = &HABABAB
    CC.CustColors(15) = &HDDDDDD
    CC.CustColors(16) = &H550000


CREATE Form AS QFORM
    CREATE Button AS QBUTTON
        Width = 100
        Caption = "Choose color"
        OnClick = ButtonClick
    END CREATE
    Center
    ShowModal
END CREATE


SUB ButtonClick (Sender AS BUTTON)
    DIM ReturnVal AS LONG

    CC.lStructSize = SIZEOF(CC)
    CC.hWndOwner = Form.Handle
    CC.Flags = CC_RGBINIT + CC_FULLOPEN
    CC.rgbResult = Form.Color

    ReturnVal = ChooseColorDlg(CC)

SelectPal Picture1.hdc, Picture1.Picture.hPal, False 
'Make windows use it 
'RealizePal Picture1.hdc 

    ''-- rgbResult is in BGR format, so no conversion is necessary.
    IF ReturnVal <> 0 THEN Form.Color = CC.rgbResult
END SUB
