Hex to rgb string conversion

[TexasPete]

I figured that someone has probably already written this routine.

I will write it from scratch if I have to but I am sure someone has written a short subroutine.

Thanks
Texas Pete

[aurelCB]

What is the purpose of your question
Hex to rgb string?

Sorry do you mean RGB(0,0,FF) -> blue or something similiar?

[LarryMc]

Zlatko,

he wants a function that is passed a color value(string) that in the "00ff00" format and returns the uint value that is the result of taking the R-G-B components and running them through the RGB function.

Larry

[TexasPete]

Larry , I think that is it. I did find a string example.

Code Select Expand


SETWINDOWCOLOR wMain1,"RGB(" + red + "," + green + "," + blue + ")"

I use rgb in my xhml format that my program writes. I want to plug in a function to do the string conversion from hex to the rgb format. Rather than rewrite all the code for hex$.
The string returned by the colorequest will work great when saved as a string and then converted back by simply using val(colorstring$). My orginal code was written to save the rgb numbers with a space in between each number.


Thanks
Texas Pete

[LarryMc]

Pete

Code Select Expand

SETWINDOWCOLOR wMain1,"RGB(" + red + "," + green + "," + blue + ")"
won't compile because of the syntax error - there are two many quotes.

The proper syntax would be:

Code Select Expand

SETWINDOWCOLOR wMain1,RGB(red ,green, blue)
where red,blue, and green are values between 0-255 or int variables containing those values.



Larry

[aurelCB]

I must confess that i'm little bit confusing ,Larry i understand what you say but i dont understand what pete trying to do.
Brain block by me - for sure

Ok here we are:

Code Select Expand

setwindowcolor w1,rgb(0x00,0x00,0xff)  -its work
and also
setwindowcolor w1,rgb(&h00,&h00,&hff)
or made smal parser which can split this hex string to three splited strings.
And then use val (r$) etc...

[sapero]

I think this will be the shortest code:

Code Select Expand

declare "!crtdll.dll", sscanf(buff:string,format:string,out1:pointer,out2:pointer,out3:pointer),int

def r,g,b:int
szHex = "112233" ' must be 6 characters long

if (sscanf(szHex, "%2x%2x%2x", r, g, b) = 3) ' if 3 values returned
messagebox 0, using("first: # # #",r,g,b), ""
endif

szHex = "aa bb cc" ' no above restriction if space separated
if (sscanf(szHex, "%x %x %x", r, g, b) = 3)
messagebox 0, using("second: # # #",r,g,b), ""
endif

[zaphod]

For converting hex value to rgb :

Code Select Expand


int c
c=0xff1008 'example
int r,g,b
r=c>>16
g=(c>>8)&0xff
b=c&0xff

and the reverse :

Code Select Expand


c=(r<<16)+(g<<8)+b

Is this what you need ?

[TexasPete]

 I think I have enough info to proceed. Let me tinker alittle today and I will see what I can come up with.

Thanks everyone.
Line upon line, precept upon precept.
Maybe I can build it now.

Thanks
Texas Pete

[sapero]

I didn't noticed this is Creative subforum; updated the code above.

[aurelCB]

Ithink that this might work:
Remove bb part becose is wrong catch string is ok with right$...

Code Select Expand

'Hex string to integer
DEF w1:window
DEF rgbcolor:uint
def rr$,gg$,bb$:string
def rr,gg,bb:int
def colorhex$:string
def hexarray[256]:string
def hn:string

Window w1,0,0,500,500,@minbox,0,"Skeleton",main
setwindowcolor w1,rgb(220,220,230)
'-------------------------------------------------------
colorhex$="0000ff" : 'blue
'-------------------------------------------------------
'fill string array with hex numbers
For n= 0 to 255
hn=hex$(n)
hexarray[n]=hn
Next n




'-------------------------------------------------------
'for red value
rr$=left$(colorhex$,2)
'move w1, 20,20:print w1,rr$
'search for red value >>>
For nr= 0 to 255
IF hexarray[nr]=rr$
rr=nr
ENDIF
Next nr
'------------------------------------------------------
' for green value
gg$=MID$ (colorhex$,3,2)
'search for green value >>>
For ng= 0 to 255
IF hexarray[ng]=gg$
gg=ng
ENDIF
Next ng

'------------------------------------------------------
bb$=right$(colorhex$,2)
move w1, 20,80:print w1,bb$
'bb$=("0x"+bb$)
IF bb$="ff" then bb=255
move w1, 20,100:print w1,bb

for n= 0 to 255
'x=x+20
hn=hex$(n)
hexarray[n]=hn
next n

move w1, 20,140:print w1,hexarray[255]

'setwindowcolor w1,rgb(rr,gg,bb)
'----------------------------------
run=1
waituntil run=0
closewindow w1
end
'----------------------------------
Sub main
select @class
case @idclosewindow
run=0
case @idcreate
centerwindow w1
endselect
Return

[aurelCB]

Oh and finaly there is right code...

Code Select Expand

'Hex string to integer
DEF w1:window
DEF rgbcolor:uint
def rr$,gg$,bb$:string
def rr,gg,bb:int
def colorhex$:string
def hexarray[256]:string
def hn:string

Window w1,0,0,500,500,@minbox,0,"Skeleton",main
setwindowcolor w1,rgb(220,220,230)
'-------------------------------------------------------
colorhex$="0000ff" : 'blue
'-------------------------------------------------------
'fill string array with hex numbers
For n= 0 to 255
hn=hex$(n)
hexarray[n]=hn
Next n




'-------------------------------------------------------
'for red value
rr$=left$(colorhex$,2)
rr$=ucase$(rr$)
'move w1, 20,20:print w1,rr$
'search for red value >>>
For nr= 0 to 255
IF hexarray[nr]=rr$
rr=nr
ENDIF
Next nr
'------------------------------------------------------
' for green value
gg$=MID$ (colorhex$,3,2)
gg$=ucase$(gg$)
'search for green value >>>
For ng= 0 to 255
IF hexarray[ng]=gg$
gg=ng
ENDIF
Next ng

'------------------------------------------------------
bb$=right$(colorhex$,2)
bb$=ucase$(bb$)

For nb= 0 to 255
IF hexarray[nb]=bb$
bb=nb
ENDIF
Next nb

'execute rr,gg,bb ---------------------------------
setwindowcolor w1,rgb(rr,gg,bb)



'----------------------------------
run=1
waituntil run=0
closewindow w1
end
'----------------------------------
Sub main
select @class
case @idclosewindow
run=0
case @idcreate
centerwindow w1
endselect
Return



[aurelCB]

Pete ask me how write this routine as small function and
here is code:

Code Select Expand

'Hex string to integer
DEF w1,w2:window
def rr$,gg$,bb$:string
def r,g,b:int
def hexarray[256]:string
def hn:string
def hexcolor:string

Declare RGBColors(colorhex:string)

Window w1,0,0,500,400,@minbox,0,"HexString To Int - Converter",main
setwindowcolor w1,rgb(220,220,230)

'add edit control as input box
CONTROL w1,"E,,11,11,74,24,0x50800000,1"
CONTROL w1,"B,CONVERT,165,15,80,20,0x50000000,2"

'-------------------------------------------------------
'Open child window
Window w2,10,50,300,200,@nocaption|@BORDER,w1,"Child Window",main

For n = 0 to 255
hn=hex$(n)
hexarray[n]=hn
Next n

' put string in function - default color blue
RGBColors("0000ff")
SetwindowColor w2,rgb(r,g,b)




'----------------------------------
run=1
waituntil run=0
closewindow w1
end
'----------------------------------
Sub main
select @class
case @idclosewindow
run=0
case @idcreate
centerwindow w1

case @idcontrol

'----------------------------------------------------------------------
IF @controlid=2
hexcolor=GetControlText(w1,1)
IF (hexcolor="")|(Len(hexcolor)>6)
MessageBox 0,"Input string is empty or size not good!","Error"
ELSE
RGBColors (hexcolor)
'MessageBox 0,"COLORS-"+"R: "+str$(r)+" ,G: "+str$(g)+" B: "+str$(b),"Colors"
SetwindowColor w2,rgb(r,g,b)
ENDIF
    ENDIF
'----------------------------------------------------------------------
endselect
Return

'rgb(hex)function >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
SUB RGBColors(colorhex:string)
r=0:g=0:b=0
'fill string array with hex numbers
'For n = 0 to 255
' hn=hex$(n)
' hexarray[n]=hn
'Next n

rr$=left$(colorhex,2)
rr$=ucase$(rr$)
'search for red value >>>
For nr= 0 to 255
IF hexarray[nr]=rr$
r=nr
ENDIF
Next nr

gg$=MID$ (colorhex,3,2)
gg$=ucase$(gg$)
'search for green value >>>
For ng= 0 to 255
IF hexarray[ng]=gg$
g=ng
ENDIF
Next ng

bb$=right$(colorhex,2)
bb$=ucase$(bb$)
'search for blue value >>>
For nb= 0 to 255
IF hexarray[nb]=bb$
b=nb
ENDIF
Next nb


'colorhex=""
'hexcolor=""
RETURN r,g,b
'end function <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

[LarryMc]

Zlatko,

Code Select Expand

RETURN r,g,b
You can return multiple values from a subroutine?

Larry

[aurelCB]

I dont get it what you mean?
You mean more then one value.
I dont know but works.
Try program.

[LarryMc]

It works because you declared those values in the main program thus making them global to the program.
I'm pretty sure they are not being returned on the stack.

Remove them from your return statement and retry the program.
If I'm right the program will still work.

The "subroutine" section of CB's help file has a sub section on functions and describes returning a VALUE and not VALUES.



Larry

[aurelCB]

Yes Larry ,you right work also without values after RETURN becose is global.
However it work

[TexasPete]

I am posting my solutions to decimal to rgb functions. Sample code below.
One subroutine decimal to r, g, b values in integer.
One Solution provides a text$ version of RGB values for printing purpose.

Thanks to everyone that offered suggestion and help.

My version aid my translation efforts from liberty basic to Creative basic.

Code Select Expand


' Demonstration of decimal to RGB$
' demonstration decimal to R G B integers
' -----------------------------------------------by Philip Hughes aka Texas Pete
'def RGBtoLong:string
'--------------defining Colors stuff
def decimal:int
def Colors$:string
def RGB$:string
def red,green,blue:int
def RedColor,BlueColor,GreenColor:int
'---------declare functions
declare DecimalToRGBString (decimal:int, Colors$:string)
declare RGBtoLong (Red:int,Green:int,Blue:Int)
declare SetDecimalToRGBTriplet (decimal:int)
def w:window
def wstyle:int
def a$,newline:string
def colors:int
def ReturnedLong:string
wstyle = @SIZE|@MINBOX
newline = chr$(10)
window w,0,0,600,400,wstyle,0,"Creative Basic",main
RedColor=200
BlueColor=200
GreenColor=134
'--------------Easy Windows-----------------
setwindowcolor w,rgb(200,250,200)
centerwindow w

control w,"T,,100,30,400,300,@cteditcenter,1"
setcontrolcolor w,1,rgb(200,255,160),rgb(140,0,180)
'rect w,99,29,402,302,rgb(0,150,150)


Colors = COLORREQUEST (w ,colors )
DecimalToRGBString (Colors,RGB$)
SetDecimalToRGBTriplet (Colors)
setwindowcolor w, rgb (Red,Green,Blue)
a$ = string$(3,newline) + "A Simple" + newline + "Creative Window"
MOVE w,4,280
print w, Red,Green,Blue
setfont w,"Arial", 20, 700, @SFITALIC,1

setcontroltext w,1,str$(colors)
MOVE w,4,300
print w, RGB$+"This is the RGB string returned"

'setwindowcolor w,rgb(200,100,200)

MOVE w,4,100
PRINT w,"This is a test!"
waituntil w = 0
END
'-----example to call for a long
'---------ReturnedLong=RGBtoLong (RedColor,BlueColor,GreenColor)
'--------------PRINT w,RGBtoLong (RedColor,BlueColor,GreenColor)


SUB main
select @CLASS
case @IDCLOSEWINDOW
closewindow w
endselect
RETURN
sub RGBtoLong (red:int,green:int,blue:Int)
def Long$:string
Long$ =str$(blue * 65536) +str$ (green * 256) +str$( red)
return Long$
sub DecimalToRGBString (decimal, Colors$)
def GetRed:int
def GetGreen:int
def GetBlue:int
def blue,green:int
'---------------------GetRed
blue=int(decimal/(256*256))
green=int((decimal-blue*256*256)/256)
        GetRed= decimal-Blue*256*256-green*256
'----------------------Getgreen
blue=int(decimal/(256*256))
GetGreen=int((decimal-blue*256*256)/256)
'------------ GetBLue
GetBlue=int(decimal/(256*256))

RGB$=str$(GetRed)+","+str$(GetGreen)+","+str$(GetBlue)
return RGB$

sub SetDecimalToRGBTriplet (decimal:int)
def GetRed:int
def GetGreen:int
def GetBlue:int
'---------------------GetRed
blue=int(decimal/(256*256))
green=int((decimal-blue*256*256)/256)
        GetRed= decimal-Blue*256*256-green*256
'----------------------Getgreen
blue=int(decimal/(256*256))
GetGreen=int((decimal-blue*256*256)/256)
'------------ GetBLue
GetBlue=int(decimal/(256*256))
red=GetRed:green=GetGreen:blue=GetBlue
return  decimal,Red ,green,blue



Thanks all .

Texas Pete
I have made copies of most of your suggestions , nothing was wasted.