Tweet
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