Had a second look at the code my young friends did the other day (http://www.ionicwind.com/forums/index.php?topic=5905.0), and found that the idea could be used as the heart of a color value selection tool. Can't remember having seen such code for CB before. The resulting code is posted below.
Colors can be changed either by writing new values into one of the edit boxes for Red, Green or Blue, or by clicking one of the Up/Down arrows to the right of each edit box. Using scrollbar control as a "spinner" (Up/Down arrows).
The resulting color and the color code values are shown immediately.
But there must be something I don't do properly, because whenever the color was changed by changing the text in one of the edit boxes, an Message Box saying "Window/Dialog Not Open on line xxx" pops up when closing the program.
Does anyone know how to get rid of that error message?
All the best!
Egil
'-------------------------------------------------------------------------------------
' ColorFinder.cba
'-------------------------------------------------------------------------------------
AutoDefine "Off"
' Declares for gcbox:
DECLARE "gdi32.dll",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int),int
DECLARE gcBox(x:int,y:int,w:int,h:int,br:int,bg:int,bb:int,msg$:string,lr:int,lg:int,lb:int)
DECLARE RGBtoDec(red:int,green:int,blue:Int) as int
DECLARE ShowColors(wnd:window,r:int,g:int,b:int)
def win:window
def red$,blue$,green$:string
def r,g,b,run:int
'Set initial color:
r=127:g=127:b=127
Window win,-435,0,435,340,0,0," CB ColorFinder",messages
setwindowcolor win, rgb(230,230,236)
drawmode win,@TRANSPARENT
'Red:
CONTROL win,"E,R,26,75,50,25,@CTEDITCENTER|@CTEDITNUMBER,10"
CONTROL win,"S,RedUpDn,78,73,20,29,@CTSCROLLVERT,11"
'Green:
CONTROL win,"E,G,176,75,50,25,@CTEDITCENTER|@CTEDITNUMBER,20"
CONTROL win,"S,RedUpDn,228,73,20,29,@CTSCROLLVERT,21"
'Blue:
CONTROL win,"E,B,326,75,50,25,@CTEDITCENTER|@CTEDITNUMBER,30"
CONTROL win,"S,RedUpDn,378,73,20,29,@CTSCROLLVERT,31"
'Set up boxes for RGB editing:
SETFONT win, "Comic Sans MS", 16, 700, @SFITALIC
gcBox( 20,50,85,70,255,178,68," R ",255,0,0)
gcBox(170,50,85,70,255,178,68," G ",0,255,0)
gcBox(320,50,85,70,255,178,68," B ",0,128,255)
'Set default values:
SETCONTROLTEXT win,10,str$(r)
SETCONTROLTEXT win,20,str$(g)
SETCONTROLTEXT win,30,str$(b)
'Show start color:
ShowColors(win,r,g,b)
run = 1
WAITUNTIL run = 0
CLOSEWINDOW win
END
'
SUB messages()
'----------------------------------------------------------------------------------------
' Main Loop
'----------------------------------------------------------------------------------------
'
SELECT @CLASS
CASE @IDCONTROL
select @controlid
CASE 10 :' RED
red$ = getcontroltext(win,10)
r = val(red$)
if r > 255 then r = 255
if r < 0 then r = 0
ShowColors(win,r,g,b)
CASE 20 :' GREEN
green$ = getcontroltext(win,20)
g = val(green$)
if g > 255 then g = 255
if g < 0 then g = 0
ShowColors(win,r,g,b)
CASE 30 :' BLUE
blue$ = getcontroltext(win,30)
b = val(blue$)
if b > 255 then b = 255
if b < 0 then b = 0
ShowColors(win,r,g,b)
endselect
CASE @IDVSCROLL :' UP/DOWN Clicked
select @controlid
CASE 11 :' RED
if @CODE = @SBLINEUP
r = r + 1
if r > 255 then r = 255
red$ = str$(r)
setcontroltext win,10,red$
ShowColors(win,r,g,b)
endif
if @CODE = @SBLINEDOWN
r = r - 1
if r < 0 then r = 0
red$ = str$(r)
setcontroltext win,10,red$
ShowColors(win,r,g,b)
endif
CASE 21 :' GREEN
if @CODE = @SBLINEUP
g = g + 1
if g > 255 then g = 255
green$ = str$(g)
setcontroltext win,20,green$
ShowColors(win,r,g,b)
endif
if @CODE = @SBLINEDOWN
g = g - 1
if g < 0 then g = 0
green$ = str$(g)
setcontroltext win,20,green$
ShowColors(win,r,g,b)
endif
CASE 31 :' BLUE
if @CODE = @SBLINEUP
b = b + 1
if b > 255 then b = 255
blue$ = str$(b)
setcontroltext win,30,blue$
ShowColors(win,r,g,b)
endif
if @CODE = @SBLINEDOWN
b = b - 1
if b < 0 then b = 0
blue$ = str$(b)
setcontroltext win,30,blue$
ShowColors(win,r,g,b)
endif
endselect
CASE @IDKEYDOWN
if GETKEYSTATE(0x1B) <> 0 then run = 0 :' ESC is pressed - end program
CASE @IDCREATE
centerwindow win
CASE @IDCLOSEWINDOW
ENABLECONTROL win,10,0
ENABLECONTROL win,20,0
ENABLECONTROL win,30,0
run = 0
ENDSELECT
RETURN
SUB ShowColors(wnd:window,r:int,g:int,b:int)
'----------------------------------------------------------------------------------------
' Showing color values and showing actual color on the screen
'----------------------------------------------------------------------------------------
'Erase "old" values:
RECT wnd,50,140,350,25,RGB(230,230,236),RGB(230,230,236)
'Print new values:
FRONTPEN wnd, RGB(0,0,0)
BACKPEN wnd,RGB(230,230,236)
SETFONT wnd, "Comic Sans MS", 10, 700
MOVE wnd,50,140
PRINT wnd,"Decimal value: ",RGBtoDec(r,g,b),+" HEX value: 0x"+hex$(RGBtoDec(r,g,b))
'Show selected color:
SETFONT wnd, "Comic Sans MS",10,700
gcBox(20,200,385,85,r,g,b," Actual Color: ",255,178,68)
RETURN
'
SUB gcBox(x:int,y:int,w:int,h:int,br:int,bg:int,bb:int,msg$:string,lr:int,lg:int,lb:int)
'------------------------------------------------------------------------
' Draw colored box with rounded corners
' Adds self dimensioning text labels with border if label text is supplied
'
' Parameters:
' x, y: Upper left corner of rounded box
' h: Box height
' w: Box with
' br: Box RED value
' bg: Box GREEN value
' bb: Box BLUE value
' msg$: Label text string - use "" if no label
' lr: Label RED value for label
' lg: Label GREEN value
' lb: Label BLUE value
'
' Note: To change radius of the rounded corners, change the values
' of the last two parameters in the RoundRect call to suit
' your needs.
'------------------------------------------------------------------------
def hdc:int
def textwidth,textheight:int
hdc = GetHDC win
RoundRect(hdc, x,y, x+w, y+h, 6, 7) :' draw rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+(w/2), y+(h/2), RGB(br,bg,bb) :' background colour
if msg$ <> "" :' text label exists?
GETTEXTSIZE win, msg$, textwidth, textheight :' label dimensions
hdc = GetHDC win
RoundRect(hdc, x+12,y-2-(textheight/2), (x+12+(textwidth)), y-2+(textheight/2)+2, 6, 7) :' draw label border
RELEASEHDC(win,hdc)
FLOODFILL win, x+14, y, RGB(lr,lg,lb) :' text label background colour
move win, x+12,y-2-(textheight/2) :' positioning text label
print win, msg$ :' printing text label
endif
RETURN
'
SUB RGBtoDec(red:int,green:int,blue:Int) as int
'----------------------------------------------------------------------------------------
' Returns and RGB triplet as integer
' Original idea: TexasPete
'----------------------------------------------------------------------------------------
if blue > 0 then blue = blue * 65536 else blue =0
if green > 0 then green = green * 256 else green = 0
RETURN blue + green + red
EDIT: Code now corrected according to the post below.
Adding three lines, disabling each of the Edit Controls when exiting, solved above problem.
So last part of the main loop now reads:
CASE @IDCLOSEWINDOW
ENABLECONTROL win,10,0
ENABLECONTROL win,20,0
ENABLECONTROL win,30,0
run = 0
To make this code more complete, I added a Menu and a simple User Guide and changed the way hexadecimal values are printed.
Also made an EXE-file and put it all in the attached zip archive.
Egil
EDIT: Zip-file deleted. An updated is posted below...
Very cool program. Too bad that for the most part when sliding thru the colors, many look the same to me. I don't see the subtle shading differences.
Bill
Hi Egil,
That's a very nice little program - saving that one ;D
all the best, :)
Graham
Glad you liked it guys.
The workshop we had the other day, was kind of a vitamin injection for me. Those young boys never stop surprising me when it comes to new ideas and how to convert their ideas into code. And that inspired me to do this program.
I have already promissed to host another workshop saturday next. Then they'll try to get the non-working CB-examples on Bitmap-Buttons to work. Think I know how to do it, but I'll let them try first, and guide them back on track if they get problems...
Tonight I have played around with this little program, wich resulted in two very important (at least for me) changes.
Instead of printing the calculated values to the screen, they are now printed into two read-only edit control boxes. Now the values can be double-clicked (for marking) and copied, and then inserted into your own code.
In addition, the hex values are now presented in BGR-format, which has to be used to get the correct colors if the hexadecimal value is used in your code instead of the RGB statement.
The updated code, EXE and User Guide are all in the attached zip file.
Have fun!
Egil