I have been playing with custom colors lately and needed a tool to quickly
view and calculate the RGB() values. I searched the forums and couldn't
find one, so I made one. It's kinda neat, so I thought I would share.
It is also an example of using multiple horizontal scrollbars.
Enjoy!
------------------
"I haven't lost my mind... its backed up on tape... I think??"
[This message has been edited by William Burns (edited January 24, 2003).]
view and calculate the RGB() values. I searched the forums and couldn't
find one, so I made one. It's kinda neat, so I thought I would share.
It is also an example of using multiple horizontal scrollbars.
Enjoy!

Code:
'=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ' RGB Calculator - by William Burns revised on 01/24/2003 ' ' A simple tool to help program with RGB colors ' '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ #COMPILE EXE #REGISTER NONE #DIM ALL #INCLUDE "win32api.inc" %FRAME1 = 100 %LABRGB = 110 %LABCOLOR = 120 %LABBLUE = 130 %LABGREEN = 135 %LABRED = 140 %HSCROLLR = 151 %HSCROLLG = 152 %HSCROLLB = 153 %TXTR = 161 %TXTG = 162 %TXTB = 163 %BUTCOPY = 220 %BUTCOPYVAL = 230 %BUTCLOSE = 240 DECLARE CALLBACK FUNCTION DlgProc GLOBAL hDlg AS LONG '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ FUNCTION PBMAIN DIALOG NEW 0, "RGB calculator", 0, 0, 219, 167, %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER, 0 TO hDlg CONTROL ADD FRAME, hDlg, %FRAME1, "Color Mix", 2, 10, 214, 66, %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, %WS_EX_TRANSPARENT CONTROL ADD LABEL, hDlg, %LABRGB, "RGB(0, 0, 0) = &&H0001", 10, 145, 140, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER CONTROL ADD LABEL, hDlg, %LABCOLOR, $CRLF + $CRLF + "Color", 5, 81, 80, 59, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_CLIENTEDGE CONTROL ADD LABEL, hDlg, %LABBLUE, "Blue", 192, 59, 19, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER CONTROL ADD LABEL, hDlg, %LABGREEN, "Green", 192, 42, 19, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER CONTROL ADD LABEL, hDlg, %LABRED, "Red", 192, 25, 19, 7, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER CONTROL ADD SCROLLBAR, hDlg, %HSCROLLR, "", 5, 22, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ CONTROL ADD SCROLLBAR, hDlg, %HSCROLLG, "", 5, 39, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ CONTROL ADD SCROLLBAR, hDlg, %HSCROLLB, "", 5, 57, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ CONTROL ADD TEXTBOX, hDlg, %TXTR, " 15", 165, 22, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE CONTROL ADD TEXTBOX, hDlg, %TXTG, " 150", 165, 39, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE CONTROL ADD TEXTBOX, hDlg, %TXTB, " 150", 165, 57, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE CONTROL ADD "Button", hDlg, %BUTCOPY, "&Copy RGB statement to clipboard", 93, 81, 123, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CONTROL ADD "Button", hDlg, %BUTCOPYVAL, "Copy RGB &value to clipboard", 93, 101, 123, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CONTROL ADD "Button", hDlg, %BUTCLOSE, "&Close", 163, 140, 53, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CONTROL SET COLOR hDlg, %LABRED, &H0FF, -1 CONTROL SET COLOR hDlg, %LABGREEN, &H0FF00, -1 CONTROL SET COLOR hDlg, %LABBLUE, &H0FF0000, -1 DIALOG SHOW MODAL hDlg, CALL DlgProc END FUNCTION '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ FUNCTION SendClipBoardText(sText AS STRING) AS LONG LOCAL hData AS LONG LOCAL hGlob AS LONG hData = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_DDESHARE, LEN(sText)+1) hGlob = GlobalLock(hData) POKE$ hGlob, sText + CHR$(0) GlobalUnlock hData IF OpenClipboard(%NULL) THEN EmptyClipboard FUNCTION = SetClipboardData(%CF_TEXT, hData) CloseClipboard ELSE GlobalFree hData END IF END FUNCTION '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ SUB UpdateRGB(BYVAL iRed AS LONG, BYVAL iGreen AS LONG, BYVAL iBlue AS LONG) CONTROL SET TEXT hDlg, %LABRGB, "RGB(" + FORMAT$(iRed) + "," + STR$(iGreen) + "," + STR$(iBlue) + ") = &&H0" + HEX$(RGB(iRed, iGreen, iBlue)) IF (iRed + iGreen + iBlue) > 400 THEN CONTROL SET COLOR hDlg, %LABCOLOR, %BLACK, RGB(iRed, iGreen, iBlue) ELSE CONTROL SET COLOR hDlg, %LABCOLOR, %WHITE, RGB(iRed, iGreen, iBlue) END IF CONTROL REDRAW hDlg, %LABCOLOR END SUB '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ CALLBACK FUNCTION DlgProc LOCAL iID AS LONG LOCAL iCounter AS LONG LOCAL sText AS STRING STATIC iColor() AS LONG 'store each scrollbar position STATIC iBar() AS LONG 'store true scrollbar handles SELECT CASE CBMSG CASE %WM_INITDIALOG REDIM iColor(1:3) REDIM iBar(1:3) iColor(1) = 15 iColor(2) = 150 iColor(3) = 150 FOR iCounter = 1 TO 3 CONTROL HANDLE CBHNDL, 150 + iCounter TO iBar(iCounter) SetScrollRange iBar(iCounter), %SB_CTL, 0, 255, %FALSE SetScrollPos iBar(iCounter), %SB_CTL, iColor(iCounter), %TRUE NEXT iCounter CALL UpdateRGB(iColor(1), iColor(2), iColor(3)) CASE %WM_HSCROLL iID = GetDlgCtrlID(CBLPARAM) - 150 'get the correct scroll bar SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINERIGHT : INCR iColor(iID) CASE %SB_PAGERIGHT : iColor(iID) = iColor(iID) + 32 CASE %SB_LINELEFT : DECR iColor(iID) CASE %SB_PAGELEFT : iColor(iID) = iColor(iID) - 32 CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : iColor(iID) = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT iColor(iID) = MAX&(0, MIN&(iColor(iID), 255))' Ensure range is correct 0-255 CONTROL SET TEXT hDlg, iID + 160, FORMAT$(iColor(iID)) FUNCTION = 1 CASE %WM_CLOSE CASE %WM_COMMAND SELECT CASE CBCTL CASE %TXTR, %TXTG, %TXTB 'typed number IF CBCTLMSG = %EN_CHANGE THEN CONTROL GET TEXT hDlg, CBCTL TO sText iColor(CBCTL - 160) = MAX&(0, MIN&(VAL(sText), 255))' Ensure range is correct 0-255 SetScrollPos iBar(CBCTL - 160), %SB_CTL, iColor(CBCTL - 160), %TRUE CALL UpdateRGB(iColor(1), iColor(2), iColor(3)) END IF CASE %BUTCOPY IF CBCTLMSG = %BN_CLICKED THEN sText = "RGB(" + FORMAT$(iColor(1)) + "," + STR$(iColor(2)) + "," + STR$(iColor(3)) + ")" IF SendClipBoardText(sText) THEN MSGBOX sText + " is now in the clipboard ready to paste", %MB_ICONINFORMATION,"Done." ELSE MSGBOX "Error sending " + sText + " to clipboard!",,"Error" END IF END IF CASE %BUTCOPYVAL IF CBCTLMSG = %BN_CLICKED THEN sText = "&H0" + HEX$(RGB(iColor(1),iColor(2),iColor(3))) IF SendClipBoardText(sText) THEN MSGBOX sText + " is now in the clipboard ready to paste",%MB_ICONINFORMATION,"Done." ELSE MSGBOX "Error sending " + sText + " to clipboard!",,"Error" END IF END IF CASE %BUTCLOSE IF CBCTLMSG = %BN_CLICKED THEN DIALOG END hDlg END IF CASE ELSE END SELECT CASE ELSE END SELECT END FUNCTION '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
"I haven't lost my mind... its backed up on tape... I think??"
[This message has been edited by William Burns (edited January 24, 2003).]
Comment