This is basically a clone of the standard windows color picker, including HSL and RGB value editing.
sync on
sync rate 0
set display mode 1024,768,32
cls
make object cube 1,10
color backdrop 0
set ambient light 0
type button_type
x1
y1
x2
y2
label as string
exist
event
temp$
endtype
global max_button_amount=9
dim button(max_button_amount) as button_type
global textbox_col=0
dim oldkeystate(300)
dim oldmousestate(5)
dim mousepress(5)
dim keypress(300)
color=color_picker(150,150)
color object 1,color
do
turn object left 1,0.2
pitch object up 1,0.1
if mouseclick()=2
color=color_picker(mousex(),mousey())
color object 1,color
endif
sync
loop
function color_picker(wx1,wy1)
local x0 as float
local y0 as float
local x1 as float
local y1 as float
local x2 as float
local y2 as float
local red as float
local green as float
local blue as float
local wx2
local wy2
local width
local height
local m
local pos
local color
wx2=wx1+260
wy2=wy1+200
width=235
height=140
m = free_memblock()
make memblock m,12+4*width*height
write memblock dword m,0,width
write memblock dword m,4,height
write memblock dword m,8,32
for x=0 to width-1
for y=0 to height-1
color=HSL((360.0*x)/width,(100.0*(height-y))/height,(50.0*(height-y*0.5))/height)
pos=12+y*width*4+x*4
write memblock byte m,pos,rgbb(color)
write memblock byte m,pos+1,rgbg(color)
write memblock byte m,pos+2,rgbr(color)
write memblock byte m,pos+3,255
next y
next x
img1=free_image()
make image from memblock img1,m
delete memblock m
mouse_click_type=1
local color1=1
local color2=2
make_button(1,"Color1",wx1+2,wy1+2,wx1+2+width,wy1+2+height)
make_button(2,"Color2",button(1).x2+3,button(1).y1,wx2-2,button(1).y2)
h=text height("X")+1
make_button(3,"Hue",button(color1).x1+35+text width("X")*4,button(color1).y2+5,button(color1).x1+37+text width("X")*7,button(color1).y2+5+h)
make_button(4,"Sat",button(color1).x1+35+text width("X")*4,button(color1).y2+5+h+1,button(color1).x1+37+text width("X")*7,button(color1).y2+5+h*2)
make_button(5,"Lum",button(color1).x1+35+text width("X")*4,button(color1).y2+5+h*2+1,button(color1).x1+37+text width("X")*7,button(color1).y2+5+h*3)
make_button(6,"Red",button(color1).x1+115+text width("X")*4,button(color1).y2+5,button(color1).x1+117+text width("X")*7,button(color1).y2+5+h)
make_button(7,"Green",button(color1).x1+115+text width("X")*4,button(color1).y2+5+h+1,button(color1).x1+117+text width("X")*7,button(color1).y2+5+h*2)
make_button(8,"Blue",button(color1).x1+115+text width("X")*4,button(color1).y2+5+h*2+1,button(color1).x1+117+text width("X")*7,button(color1).y2+5+h*3)
make_button(9,"Ok",button(color1).x1+165+text width("X")*4,button(color1).y2+5+h*2+1,button(color1).x1+197+text width("X")*7,button(color1).y2+5+h*3)
y2=(button(color1).y2-button(color1).y1)/2.0
global focus$="Color1"
selected_button=1
img2=free_image()
width2=button(color2).x2-button(color2).x1
height2=height
make memblock m,12+4*width2*height2
write memblock dword m,0,width2
write memblock dword m,4,height2
write memblock dword m,8,32
do
set cursor 0,0
ink rgb(155,155,155),0
box wx1,wy1,wx2,wy2
ink rgb(200,200,200),0
box button(9).x1,button(9).y1,button(9).x2,button(9).y2
ink rgb(100,100,100),0
box button(9).x1+1,button(9).y1+1,button(9).x2,button(9).y2
ink rgb(155,155,155),0
box button(9).x1+1,button(9).y1+1,button(9).x2-1,button(9).y2-1
ink 0,0
center text 0.5*(button(9).x1+button(9).x2),button(9).y1+1,"Ok"
paste image img1,button(color1).x1,button(color1).y1
ink 0,0
text button(color1).x1+35,button(color1).y2+5,"Hue:"
text button(color1).x1+35,button(color1).y2+5+h,"Sat:"
text button(color1).x1+35,button(color1).y2+5+h*2,"Lum:"
text button(color1).x1+text width("X")*4+115-text width("Red:"),button(color1).y2+5,"Red:"
text button(color1).x1+text width("X")*4+115-text width("Green:"),button(color1).y2+5+h,"Green:"
text button(color1).x1+text width("X")*4+115-text width("Blue:"),button(color1).y2+5+h*2,"Blue:"
mc=mouseclick()
keystates()
if mousepress(1)=1
x0=mousex()
y0=mousey()
selected_button=0
focus$="null"
for n=1 to max_button_amount
if button(n).exist=1 and y0>button(n).y1 and y0<button(n).y2 and x0>button(n).x1 and x0<button(n).x2
focus$=button(n).label
selected_button=n
endif
next n
endif
if focus$="Color1"
if mc=1
mx=mousex()
my=mousey()
endif
if mx>button(selected_button).x2-1 then mx=button(selected_button).x2-1
if my>button(selected_button).y2-1 then my=button(selected_button).y2-1
if mx<button(selected_button).x1 then mx=button(selected_button).x1
if my<button(selected_button).y1 then my=button(selected_button).y1
x1=mx-button(selected_button).x1
y1=my-button(selected_button).y1
color=HSL((360.0*x1)/width,(100.0*(height-y1))/height,(50.0*(height-y1*0.5))/height)
hue=(360.0*x1)/width
sat=(100.0*(height-y1))/height
if sat>100 then sat=100
if sat<1 then sat=1
for x=0 to width2-1
for y=0 to height2-1
color=HSL(hue,sat,(100.0*(height2-y))/height2)
pos=12+y*width2*4+x*4
write memblock byte m,pos,rgbb(color)
write memblock byte m,pos+1,rgbg(color)
write memblock byte m,pos+2,rgbr(color)
write memblock byte m,pos+3,255
next y
next x
if image exist(img2)=1 then delete image img2
make image from memblock img2,m
endif
paste image img2,button(color2).x1,button(color2).y1
if focus$="Color2" and mc=1
y2=mousey()-button(selected_button).y1
if y2<0 then y2=0
if y2>button(selected_button).y2-button(selected_button).y1 then y2=button(selected_button).y2-button(selected_button).y1
endif
ink 0xffffff,0
box button(color2).x1,y2+button(color2).y1,button(color2).x2,y2+button(color2).y1+1
hue#=(360.0*x1)/width
sat#=(100.0*(height-y1))/height
lum#=(100.0*(height2-y2))/height2
color=HSL(hue#,sat#,lum#)
red=rgbr(color)
green=rgbg(color)
blue=rgbb(color)
red$=str$(red)
green$=str$(green)
blue$=str$(blue)
if mouseclick()=0
mouse_click_type=0
endif
ink 0xffffff,0
box mx-1,my-10,mx+1,my+10
box mx-10,my-1,mx+10,my+1
ink color,0
box button(color1).x1+2,button(color1).y2+5,button(color1).x1+30,button(color1).y2+h*3+6
hue$=str$(int(hue#))
sat$=str$(int(sat#))
lum$=str$(int(lum#))
hue$=text_box(3,hue$,3,"number")
sat$=text_box(4,sat$,3,"number")
lum$=text_box(5,lum$,3,"number")
red$=str$(red)
green$=str$(green)
blue$=str$(blue)
red$=text_box(6,red$,3,"number")
green$=text_box(7,green$,3,"number")
blue$=text_box(8,blue$,3,"number")
if (abs(val(red$)-red)>2 or abs(val(green$)-green)>2 or abs(val(blue$)-blue)>2)
closest#=2000
for r#=val(red$)-3.00 to val(red$)+3.0 step 0.5
for g#=val(green$)-3.00 to val(green$)+3.0 step 0.5
for b#=val(blue$)-3.00 to val(blue$)+3.0 step 0.5
h$=str$(RGBH(r#,g#,b#))
s$=str$(RGBS(r#,g#,b#))
l$=str$(RGBL(r#,g#,b#))
color=HSL(val(h$),val(s$),val(l$))
d#=(rgbr(color)-val(red$))^2+(rgbg(color)-val(green$))^2+(rgbb(color)-val(blue$))^2
if d#<closest#
closest#=d#
hue$=h$
sat$=s$
lum$=l$
endif
next b#
next g#
next r#
endif
if abs(val(hue$)-hue#)>1 or abs(val(sat$)-sat#)>1
if abs(val(hue$)-hue#)>1
hue#=val(hue$)
hue1#=-13
d#=0
t=0
while hue#<>hue1# and t<3
inc t
if hue1#<hue#
inc d#,0.1
endif
if hue1#>hue#
dec d#,0.1
endif
x1=(0.0+hue#)*width/360.0+d#
if x1>button(color1).x2-button(color1).x1 then x1=button(color1).x2-button(color1).x1
if x1<0 then x1=0
mx=x1+button(color1).x1
hue1#=(360.0*x1)/width
endwhile
else
hue#=val(hue$)
endif
if abs(val(sat$)-sat#)>1
sat#=val(sat$)
sat1#=-13
d#=0
t=0
while sat#<>sat1# and t<3
inc t
if sat1#<sat#
inc d#,0.1
endif
if sat1>sat
dec d#,0.1
endif
y1=height-0.01*sat#*height-d#
if y1>button(color1).y2-button(color1).y1-1 then y1=button(color1).y2-button(color1).y1-1
if y1<0 then y1=0
my=y1+button(color1).y1
sat1#=(100.0*(height-y1))/height
endwhile
else
sat#=val(sat$)
endif
color=HSL((360.0*x1)/width,(100.0*(height-y1))/height,(50.0*(height-y1*0.5))/height)
sat#=(100.0*(height-y1))/height
if sat#>100 then sat#=100
if sat#<1 then sat#=1
for x=0 to width2-1
for y=0 to height2-1
color=HSL(hue#,sat#,(100.0*(height2-y))/height2)
pos=12+y*width2*4+x*4
write memblock byte m,pos,rgbb(color)
write memblock byte m,pos+1,rgbg(color)
write memblock byte m,pos+2,rgbr(color)
write memblock byte m,pos+3,255
next y
next x
if image exist(img2)=1 then delete image img2
make image from memblock img2,m
endif
if abs(val(lum$)-lum#)>1
lum#=val(lum$)
lum1#=-13
d#=0
t=0
while lum#<>lum1# and t<3
inc t
if lum1#<lum#
inc d#,0.1
endif
if lum1#>lum#
dec d#,0.1
endif
y2=height2-0.01*lum#*height2-d#
if y2>button(color2).y2-button(color2).y1 then y2=button(color2).y2-button(color2).y1
if y2<0 then y2=0
lum1#=(100.0*(height2-y2))/height2
endwhile
else
lum#=val(lum$)
endif
color=HSL(hue#,sat#,lum#)
red=rgbr(color)
green=rgbg(color)
blue=rgbb(color)
if selected_button=9
exit
endif
sync
loop
delete image img1
delete image img2
delete memblock m
endfunction color
function make_button(num,label$,x1,y1,x2,y2)
button(num).label=label$
button(num).x1=x1
button(num).x2=x2
button(num).y1=y1
button(num).y2=y2
button(num).exist=1
endfunction
function HSL(H#,S#,L#)
if S#<=0 then S#=0.0
`Converts a HSL color to an RGB color.
S#=S#/100.0:L#=L#/100.0:H#=H#/360
`hue key points 0=red, 60=yellow, 120=green, 180=cyan, 240=blue,300=magenta, then loops at 360
if S#=0.0
red#=L#:green#=L#:blue#=L#
goto out
endif
if L#<0.5
temp2#=L#*(1.0+S#)
else
temp2#=L#+S# - L#*S#
endif
temp1# = 2.0*L# - temp2#
rtemp#=H#+1.0/3.0
gtemp#=H#
btemp#=H#-1.0/3.0
red#=convRGB(temp1#,temp2#,rtemp#)
green#=convRGB(temp1#,temp2#,gtemp#)
blue#=convRGB(temp1#,temp2#,btemp#)
out:
r=red#*255
g=green#*255
b=blue#*255
color=rgb(r,g,b)
endfunction color
function convRGB(v1#,v2#,vH#)
`Some function thing used by HSL() (I didn't make it myself, no clue what it does)
if vH#<0.0 then vH#=vH#+1.0
if vH#>1.0 then vH#=vH#-1.0
If 6.0*vH# < 1.0 : output#=v1#+(v2#-v1#)*6.0*vH# : goto out : endif
if 2.0*vH# < 1.0 : output#=v2# : goto out:endif
if 3.0*vH# < 2.0 : output#=v1#+(v2#-v1#)*((2.0/3.0)-vH#)*6.0 : goto out : endif
output#= v1#
out:
endfunction output#
function text_box(num,var$,max_length,variable_type$)
name$=button(num).label
x1=button(num).x1
y1=button(num).y1
x2=button(num).x2
y2=button(num).y2
ink 0xffffff,0
box x1,y1,x2,y2
oldvar$=var$
if focus$=name$ and button(num).event=0
button(num).event=1
button(num).temp$=var$
endif
if focus$<>name$
if button(num).event=1
var$=button(num).temp$
button(num).event=0
endif
endif
if button(num).event=1
if mousepress(1)=1
clear entry buffer
textbox_col=int((mousex()-x1+0.0)/text width("X")+0.5)
endif
if keypress(203)=1 then dec textbox_col
if keypress(205)=1 then inc textbox_col
if len(button(num).temp$)<textbox_col
textbox_col=len(button(num).temp$)
endif
if keypress(14)=1
button(num).temp$=left$(button(num).temp$,textbox_col-1)+right$(button(num).temp$,len(button(num).temp$)-textbox_col)
dec textbox_col
endif
if keypress(211)=1
button(num).temp$=left$(button(num).temp$,textbox_col)+right$(button(num).temp$,len(button(num).temp$)-textbox_col-1)
endif
if textbox_col<0 then textbox_col=0
s$=entry$()
clear entry buffer
if keystate(14)=0 and len(s$)>0 and len(button(num).temp$)<max_length
ok=1
if variable_type$="number"
if s$="0" or val(s$)>0 or s$="-" or s$="." or s$="+"
ok=1
else
ok=0
endif
else
ok=1
endif
if ok=1
button(num).temp$=left$(button(num).temp$,textbox_col)+s$+right$(button(num).temp$,len(button(num).temp$)-textbox_col)
endif
inc textbox_col
endif
ink 0,0
box x1+textbox_col*text width("X"),y1,x1+textbox_col*text width("X")+1,y2
endif
if returnkey()=1 and button(num).event=1
var$=button(num).temp$
button(num).event=0
focus$="null"
endif
if button(num).event=0 and focus$<>name$
button(num).temp$=var$
endif
ink 0,0
text x1,y1,button(num).temp$
endfunction var$
function keystates()
for n=0 to 300
keypress(n)=keystate(n)-oldkeystate(n)
oldkeystate(n)=keystate(n)
next n
mc=mouseclick()
for m=1 to 5
mousestate=0
if mc=m:mousestate=1:endif
mousepress(m)=mousestate-oldmousestate(m)
oldmousestate(m)=mousestate
next m
endfunction
function RGBH(red as float,green as float,blue as float)
Red = red / 255.0:Green = green / 255.0:Blue = blue / 255.0
mincolor#=red:if green<mincolor#:mincolor#=green:endif:if blue<mincolor#:mincolor#=blue:endif
maxcolor#=red:if green>maxcolor#:maxcolor#=green:endif:if blue>maxcolor#:maxcolor#=blue:endif
if mincolor# = maxcolor#
exitfunction 0.0
else
lum# = (mincolor# + maxcolor#) / 2.0
if lum# < 0.5
sat# = (maxcolor# - mincolor#) / (maxcolor# + mincolor#)
else
sat# = (maxcolor# - mincolor#) / (2 - maxcolor# - mincolor#)
endif
if red = maxcolor#
hue# = (green - blue) / (maxcolor# - mincolor#)
else
if green = maxcolor#
hue# = 2 + (blue - red) / (maxcolor# - mincolor#)
else
hue# = 4 + (red - green) / (maxcolor# - mincolor#)
endif
endif
hue# = hue# / 6.0:if hue# < 0:hue# = hue# + 1:endif
endif
hue#=hue#*360.0
endfunction hue#
function RGBS(red as float,green as float,blue as float)
Red = red / 255.0:Green = green / 255.0:Blue = blue / 255.0
mincolor#=red:if green<mincolor#:mincolor#=green:endif:if blue<mincolor#:mincolor#=blue:endif
maxcolor#=red:if green>maxcolor#:maxcolor#=green:endif:if blue>maxcolor#:maxcolor#=blue:endif
if mincolor# = maxcolor#
exitfunction 0.0
else
lum# = (mincolor# + maxcolor#) / 2.0
if lum# < 0.5
sat# = (maxcolor# - mincolor#) / (maxcolor# + mincolor#)
else
sat# = (maxcolor# - mincolor#) / (2 - maxcolor# - mincolor#)
endif
endif
sat#=sat#*100.0
endfunction sat#
function RGBL(red as float,green as float,blue as float)
Red = red / 255.0:Green = green / 255.0:Blue = blue / 255.0
mincolor#=red:if green<mincolor#:mincolor#=green:endif:if blue<mincolor#:mincolor#=blue:endif
maxcolor#=red:if green>maxcolor#:maxcolor#=green:endif:if blue>maxcolor#:maxcolor#=blue:endif
Lum =(mincolor# + maxcolor#) * 50.0
endfunction Lum
function free_memblock()
repeat:inc i:until memblock exist(i)=0
endfunction i
function free_image()
repeat:inc i:until image exist(i)=0
endfunction i
[Edit] Attached is a screen shot.
