2013-06-19 07:54

'-----------------------------------------------------------|
' USAGE                                                     |
'-----------------------------------------------------------|
' Click on the "Select Color" box, and choose your color.   |
' You will get the color translation RGB and HTML. The last |
' Box contains the HTML version, but BGR instead of RGB.    |
' This format can be used in RapidQ.                        |
'-----------------------------------------------------------|

'************************************************************
'*******  BY DANNY JACKSON & DREADSOFT® CORPORATION  ********
'************************************************************

     $TYPECHECK ON
     $OPTION ICON "COLORCHOOSER.ICO"

'______________________________________________________________________________
'                                                              API Declarations
'______________________________________________________________________________

     TYPE CHOOSECOLOR
      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.dll" ALIAS "ChooseColorA" _
      (pChoosecolor AS CHOOSECOLOR) AS LONG

     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

     DECLARE FUNCTION SetFocus LIB "user32" ALIAS "SetFocus" _
      (BYVAL hwnd AS LONG) AS LONG

     CONST WM_COPY AS LONG = &H301


'______________________________________________________________________________
'                                                          Conversion Functions
'______________________________________________________________________________

     FUNCTION colRGB(COLOR AS INTEGER) AS STRING
      DIM r AS INTEGER, g AS INTEGER, b AS INTEGER
      b = FLOOR(COLOR / 65536)
      g = FLOOR((COLOR - (b * 65536)) / 256)
      r = COLOR - (b * 65536) - (g * 256)
      result = STR$(r) + "," + STR$(g) + "," + STR$(b)
     END FUNCTION

'______________________________________________________________________________

     FUNCTION rgbhex (rgbstr AS STRING) AS STRING
      DIM intval AS INTEGER
      DIM temp AS STRING
      temp = ""
      intval = VAL(FIELD$(rgbstr, ",", 1))
      temp = RIGHT$(HEX$(intval), 2)
      intval = VAL(FIELD$(rgbstr, ",", 2))
      temp = temp + RIGHT$(HEX$(intval), 2)
      intval = VAL(FIELD$(rgbstr, ",", 3))
      temp = temp + RIGHT$(HEX$(intval), 2)
      result = temp
     END FUNCTION

'______________________________________________________________________________

     FUNCTION bgrhex (rgbstr AS STRING) AS STRING
      DIM intval AS INTEGER
      DIM temp AS STRING
      temp = ""
      intval = VAL(FIELD$(rgbstr, ",", 3))
      temp = RIGHT$(HEX$(intval), 2)
      intval = VAL(FIELD$(rgbstr, ",", 2))
      temp = temp + RIGHT$(HEX$(intval), 2)
      intval = VAL(FIELD$(rgbstr, ",", 1))
      temp = temp + RIGHT$(HEX$(intval), 2)
      result = temp
     END FUNCTION

'______________________________________________________________________________

     DECLARE SUB Select_Color
     DECLARE SUB Copy_Value

     DIM CC AS CHOOSECOLOR

     DIM form AS QFORM
     WITH form
      .CAPTION = "Color Chooser"
      .center
      .font.name = "Arial"
      .height = 160
      .width = 315
      .delbordericons = 2
      .borderstyle = 1
     END WITH

     DIM ColorGB AS QGROUPBOX
     WITH ColorGB
      .PARENT = form
      .top = 10
      .left = 10
      .CAPTION = " Select color "
      .width = 80
      .height = 60
     END WITH

     DIM ColorBOX AS QLABEL
     WITH colorBOX
      .PARENT = ColorGB
      .left = 20
      .top = 20
      .width = 40
      .height = 25
      .COLOR = RGB(255,255,255)
      .cursor = -20
      .onclick = SELECT_Color
     END WITH

     DIM ValueLAB AS QRADIOBUTTON
     WITH ValueLAB
      .PARENT = Form
      .top = 15
      .left = 120
      .CAPTION = "Value"
      .checked = 1
     END WITH

     DIM ValueBOX AS QEDIT
     WITH ValueBox
      .PARENT = Form
      .top = 10
      .left = 200
      .width = 95
     END WITH

     DIM rgbLAB AS QRADIOBUTTON
     WITH rgbLAB
      .PARENT = Form
      .top = 45
      .left = 120
      .CAPTION = "RGB"
     END WITH

     DIM rgbBOX AS QEDIT
     WITH rgbBox
      .PARENT = Form
      .top = 40
      .left = 200
      .width = 95
     END WITH

     DIM HTMLLAB AS QRADIOBUTTON
     WITH HTMLLAB
      .PARENT = Form
      .top = 75
      .left = 120
      .CAPTION = "HTML"
     END WITH

     DIM HTMLBOX AS QEDIT
     WITH HTMLBox
      .PARENT = Form
      .top = 70
      .left = 200
      .width = 95
     END WITH

     DIM HTbgrLAB AS QRADIOBUTTON
     WITH HTbgrLAB
      .PARENT = Form
      .top = 105
      .left = 120
      .CAPTION = "HTML (RQ)"
     END WITH

     DIM HTbgrBOX AS QEDIT
     WITH HTbgrBox
      .PARENT = Form
      .top = 100
      .left = 200
      .width = 95
     END WITH

     DIM CopyBUT AS QBUTTON
     WITH CopyBut
      .PARENT = form
      .top = 80
      .left = 10
      .width = 80
      .height = 40
      .CAPTION = "Copy"
      .onclick = Copy_Value
     END WITH

     Form.SHOWMODAL

'______________________________________________________________________________

     SUB Select_Color
      DIM ReturnVal AS LONG
      CC.lStructSize = SIZEOF(CC)
      CC.hWndOwner = ColorGB.handle
      ReturnVal = ChooseColorDlg(CC)
      IF ReturnVal <> 0 THEN
       ColorBOX.COLOR = CC.rgbResult
       ValueBOX.TEXT = STR$(CC.rgbResult)
       rgbBOX.text = "RGB" & CHR$(40) & colrgb(CC.rgbResult) & CHR$(41)
       HTMLBOX.text = CHR$(35) & rgbhex(rgbbox.text)
       HTbgrBOX.text =  CHR$(38) & "H" & bgrhex(rgbbox.text)
      END IF
     END SUB

'______________________________________________________________________________

     SUB COPY_VALUE
      DIM colorstring AS STRING
      IF ValueLAB.checked = 1 THEN
       colorstring = ValueBOX.text
      ELSEIF rgbLAB.checked = 1 THEN
       colorstring = rgbBOX.text
      ELSEIF HTMLLAB.checked = 1 THEN
       colorstring = htmlbox.text
      ELSEIF HTbgrlab.checked = 1 THEN
       colorstring = htbgrbox.text
      END IF
      Clipboard.text = Colorstring
     END SUB

2013-06-19 07:54