very simple color picker

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

very simple color picker

Postby D.J.Peters » Feb 02, 2009 19:43

Code: Select all

function GetColor(x as integer,y as integer) as uinteger
  if x<0 or x>254 then return 0
  if y<0 or y>254 then return 0
  dim a as single = (y/127.0)*3.14159
  dim w as single = x/254.0
  dim c as single = iif(w<0.5,255.0*w,255.0*(1.0-w))
  w*=255.0
  dim as integer r = int(w+c*cos(a))
  dim as integer g = int(w+c*cos(a+2*3.14159/3.0))
  dim as integer b = int(w+c*cos(a+4*3.14159/3.0))
  return RGB(r,g,b)
end function


dim as integer mx,my
ScreenRes 255,255,32
ScreenLock
for my =0 to 254
  for mx =0 to 254
    pset(mx,my),GetColor(mx,my)
  next
next
ScreenUnlock
while inkey=""
  if GetMouse(mx,my)=0 then
    WindowTitle "RGB=&H" & hex(GetColor(mx,my),6)
  else
    sleep(50)
  end if
wend
end
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Feb 02, 2009 21:44

That's neat. I like it.
BasicCoder2
Posts: 3404
Joined: Jan 01, 2009 7:03

Postby BasicCoder2 » Feb 03, 2009 4:43

Maybe display the color as a block to see what you have picked?

Code: Select all

Function GetColor(x As Integer,y As Integer) As Uinteger
  If x<0 Or x>254 Then Return 0
  If y<0 Or y>254 Then Return 0
  Dim a As Single = (y/127.0)*3.14159
  Dim w As Single = x/254.0
  Dim c As Single = iif(w<0.5,255.0*w,255.0*(1.0-w))
  w*=255.0
  Dim As Integer r = Int(w+c*Cos(a))
  Dim As Integer g = Int(w+c*Cos(a+2*3.14159/3.0))
  Dim As Integer b = Int(w+c*Cos(a+4*3.14159/3.0))
  Return RGB(r,g,b)
End Function


Dim As Integer mx,my
ScreenRes 355,255,32
ScreenLock
For my =0 To 254
  For mx =0 To 254
    Pset(mx,my),GetColor(mx,my)
  Next
next
ScreenUnlock
While Inkey=""
  If GetMouse(mx,my)=0 Then
    WindowTitle "RGB=&H" & Hex(GetColor(mx,my),6)
    line(280,100)-(320,150),point(mx,my),bf 'DISLAY COLOR BLOCK
  Else
    Sleep(50)
  End If
Wend
End

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest