Download RGB2Clip.zip file

#if 0
    ----------------------------                      PowerBASIC v8.x
 ---|          DASoft          |------------------------------------------
    ----------------------------         Code           DATE: 2005-02-19
    | FILE NAME  pickcolor.bas |          by
    ----------------------------  Don Schullian, Jr.

              This code is released into the Public Domain
       ----------------------------------------------------------
        No guarantee as to the viability, accuracy, or safety of
         use of this code is implied, warranted, or guaranteed
       ----------------------------------------------------------
                         Use at your own risk!
       ----------------------------------------------------------
                  CONTACT AUTHOR AT d83@DASoftVSS.com
 -------------------------------------------------------------------------
#endif

#IF 0

  This function uses the Windows ChooseColor common dialog.

  Some flags that can be used with the dialog:
  You can experiment with different combinations of these.
  %CC_RGBINIT                     = &H00000001&
  %CC_FULLOPEN                    = &H00000002&
  %CC_PREVENTFULLOPEN             = &H00000004&
  %CC_SHOWHELP                    = &H00000008&
  %CC_ENABLEHOOK                  = &H00000010&
  %CC_ENABLETEMPLATE              = &H00000020&
  %CC_ENABLETEMPLATEHANDLE        = &H00000040&

  TYPE CHOOSECOLORAPI            ' Structure used by the dialog
    lStructSize    AS LONG       'the length, in bytes, of the structure
    hwndOwner      AS LONG       'Identifies the window that owns the dialog box. This member can be any valid window handle, or it can be NULL if the dialog box has no owner.
    hInstance      AS LONG       'If neither CC_ENABLETEMPLATEHANDLE nor CC_ENABLETEMPLATE is set, this member is ignored
    rgbResult      AS DWORD      'If the CC_RGBINIT flag is set, rgbResult specifies the color initially selected when the dialog box is created. If the user clicks the OK button, rgbResult specifies the user's color selection.
    lpCustColors   AS DWORD PTR  'Pointer to an array of 16 COLORREF values. To preserve new custom colors between calls to the ChooseColor function, you should allocate static memory for the array.
    Flags          AS LONG       'flags that you can use to initialize the Color common dialog box.
    lCustData      AS LONG       'Specifies application-defined data that the system passes to the hook procedure identified by the lpfnHook member.
    lpfnHook       AS DWORD      'This member is ignored unless the CC_ENABLEHOOK flag is set in the Flags member
    lpTemplateName AS ASCIIZ PTR 'This member is ignored unless the CC_ENABLETEMPLATE flag is set in the Flags member.
  END TYPE

#ENDIF
#if 1
#INCLUDE "win32api.inc"
#INCLUDE "comdlg32.inc"

DECLARE FUNCTION fChooseColor (BYVAL DefClr&,OPT BYVAL hParent AS DWORD,OPT BYVAL CustomClrsPtr AS LONG PTR) AS LONG
'
'------------------------------------------------------------------------------
'
FUNCTION fRGB2STR ( BYVAL Colour AS LONG ) EXPORT AS STRING

  DIM P   AS LOCAL LONG
  DIM Txt AS LOCAL STRING * 11

  FOR P = 1 TO 9 STEP 4
    MID$(Txt,P,4) = FORMAT$(LO(BYTE,Colour), "00#\,")
    ROTATE RIGHT Colour, 8
  NEXT

  FUNCTION = Txt

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION PBmain ()

  DIM C(15) AS LOCAL LONG
  DIM R     AS LOCAL LONG
  DIM T     AS LOCAL STRING

  R = fChooseColor(%BLUE,0,VARPTR(C(0)))
  T = fRGB2STR(R) & $CRLF
  FOR R = 0 TO 15
    T = T & $CRLF & fRGB2STR(C(R))
  NEXT
  MSGBOX T

END FUNCTION

#endif
'
'------------------------------------------------------------------------------
'
FUNCTION fChooseColor (     BYVAL  CurrentColor AS LONG    , _
                        OPT BYVAL hParent       AS DWORD   , _
                        OPT BYVAL CustomClrsPtr AS LONG PTR  ) EXPORT AS LONG

    DIM tCS AS LOCAL CHOOSECOLORAPI

    IF CustomClrsPtr = 0 THEN
        DIM Colors(15) AS LOCAL LONG
        tCS.Flags = %CC_PREVENTFULLOPEN
        CustomClrsPtr = VARPTR(Colors(0))
      ELSE
        tCS.Flags = %CC_FULLOPEN
    END IF
    tCS.lStructSize  = SIZEOF(CHOOSECOLORAPI)
    tCS.hwndOwner    = hParent
    tCS.lpCustColors = CustomClrsPtr
    tCS.rgbResult    = CurrentColor
    tCS.Flags        = tCS.Flags OR %CC_RGBINIT

    ChooseColor tCS

    FUNCTION = tCS.rgbResult

END FUNCTION