March 28, 2024, 03:04:54 PM

News:

IonicWind Snippit Manager 2.xx Released!  Install it on a memory stick and take it with you!  With or without IWBasic!


Finding colors

Started by Egil, August 13, 2016, 08:59:28 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Egil

August 13, 2016, 08:59:28 AM Last Edit: August 13, 2016, 11:20:20 AM by Egil
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.
Support Amateur Radio  -  Have a ham  for dinner!

Egil

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


Support Amateur Radio  -  Have a ham  for dinner!

Egil

August 14, 2016, 03:19:12 AM #2 Last Edit: August 18, 2016, 02:15:41 PM by Egil
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...
Support Amateur Radio  -  Have a ham  for dinner!

billhsln

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
When all else fails, get a bigger hammer.

GWS

Hi Egil,

That's a very nice little program - saving that one  ;D

all the best, :)

Graham
Tomorrow may be too late ..

Egil

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... 
Support Amateur Radio  -  Have a ham  for dinner!

Egil

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

Support Amateur Radio  -  Have a ham  for dinner!