Colour Finder

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Colour Finder

Post by dodicat »

I had this in another thread, but I have titivated it a bit to post here.
To save a colour press space bar.
But please make sure that the little window is active if you do this.
By save I mean that the results are shown on a console where they can be copied.

Code: Select all

 
#include "crt.bi"
Type screenpoint
    As Integer x,y
End Type
Extern "windows" Lib "user32"
Declare Function GetDC Alias "GetDC" (Byval As Any Ptr) As Any Ptr
Declare Function PopBeep Alias "MessageBeep" (Byval As Integer) As Integer
End Extern
Extern "windows" Lib "gdi32"
Declare Function _point Alias "GetPixel"(Byval As Any Ptr,Byval As Integer,Byval As Integer) As Uinteger
End Extern
Declare Function _getmouse Alias "GetCursorPos" (Byval As Any Pointer) As Integer
Declare Function NoConsole Alias "FreeConsole" () As Integer
declare function ShowConsole alias "AllocConsole"  as integer
Dim Shared As Integer xres,yres
'=============================
function HTML(v as uinteger) as string
    dim as string hx=hex(v)
    hx=string(6-len(hx),"0")+hx
    swap hx[0],hx[4]
    swap hx[1],hx[5]
return hx
end function
'=======================================
Dim As Any Ptr MyScreen = GetDC(0)
Dim As Uinteger v

Screenres 200,200,32,,&h20 or &h40
Windowtitle "Colour finder"
Screeninfo xres,yres 
width xres\8,yres\16
NoConsole
Dim As Ubyte r,g,b
Color ,RGB (236,233,216)
Dim As screenpoint m
dim as string key,s="  " +chr(10),msg 
dim as integer x,y
Do
    key=inkey
    if key=" "  then 
        popbeep(0)
var bb=string(3-len(str(b)),"0")+str(b),rr=string(3-len(str(r)),"0")+str(r),gg=string(3-len(str(g)),"0")+str(g)
var sp=string(6-len(hex(v))," ")
        s+= "RGB (" & bb &"," & gg &"," & rr &")"+ "   HEX &h"+hex(v)+sp+"   HTML #"+HTML(v) +chr(10)
    end if
    _getmouse @m
    screencontrol 0,x,y
if m.x>x and m.x<x+xres and m.y>y and m.y<y+yres then msg="<space> to save a colour" else msg="" 
    Screenlock
    Cls
    Locate 1,1
    Color 0
    print "X,Y   ";str(m.x);",";str(m.y)
    'print
    Print "Red   ";b
    Print "Green ";g
    Print "Blue  ";r
    print
    locate 10,1
    print "HEX   &h";hex(v)
    draw string(0,180),msg,rgb(0,0,0)
    print "HTML   #";HTML(v)
    Line(100-30,100-30)-(100+30,100+30),Rgb(b,g,r),bf
    Line(100-30,100-30)-(100+30,100+30),Rgb(0,0,0),b
    v=_point(MyScreen,m.x,m.y)
    r= Cptr(Ubyte Ptr,@v)[2] 'Or just use the standard r,g,b extract method
    g= Cptr(Ubyte Ptr,@v)[1] 'but this method is a tad faster
    b= Cptr(Ubyte Ptr,@v)[0]
    Screenunlock
    Sleep 1,1
Loop Until key=Chr(255,107) or key=chr(27)
 if s<>"  " +chr(10) then
screen 0
showconsole
puts(s)
sleep
end if


  
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: Colour Finder

Post by Quark »

.
Having used this program, I'll add to the instructions. Have some image up that has colors to use, run the Color Finder program, click on the little window to make sure it has the focus. Move the mouse cursor to a desired color (don't click), press the space bar, repeat last two actions. All the color values in rgb, hex, and HTML format are listed on the console screen. Very useful, though only rarely was I able to copy from the console (don't know what that's all about). Also, the console window seems not always to behave itself.
.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Colour Finder

Post by dodicat »

Thanks for testing Quark.

Try print s instead of puts(s) (Third line from bottom).

If you use print you don't need to include the crt.bi file.

No problem copying from the console with Win XP.

Somebody else was having an issue though:
http://www.freebasic.net/forum/viewtopi ... =2&t=22879
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: Colour Finder

Post by Quark »

.
@dodicat

Tried your suggested change, no luck. Probably some Vista thing. But I have no problem copying by hand when the information is that useful.

I may mess around with your code to save the info to a file, if you don't beat me to it. However, I now have a good set of colors which I am content with for the moment. Your program was a genuine help.
.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Colour Finder

Post by dodicat »

Okay.
I've used chr(13) + chr(10) to end a line.
Notepad should handle this.
Also written to a text file (colours.txt)

Code: Select all

   

Type screenpoint
    As Integer x,y
End Type
'Windows job lot from system32:
Extern "windows" Lib "user32"
Declare Function GetDC Alias "GetDC" (Byval As Any Ptr) As Any Ptr
Declare Function PopBeep Alias "MessageBeep" (Byval As Integer) As Integer
End Extern
Extern "windows" Lib "gdi32"
Declare Function _point Alias "GetPixel"(Byval As Any Ptr,Byval As Integer,Byval As Integer) As Uinteger
End Extern
Declare Function _getmouse Alias "GetCursorPos" (Byval As Any Pointer) As Integer
Declare Function NoConsole Alias "FreeConsole" () As Integer
declare function ShowConsole alias "AllocConsole"  as integer
declare function Title  alias "SetConsoleTitleA" (as zstring) as integer
Dim Shared As Integer xres,yres
'=============================
function HTML(v as uinteger) as string
    dim as string hx=hex(v)
    hx=string(6-len(hx),"0")+hx
    swap hx[0],hx[4]
    swap hx[1],hx[5]
return hx
end function
'=======================================
Dim As Any Ptr MyScreen = GetDC(0)
Dim As Uinteger v

Screenres 200,200,32,,&h20 or &h40
Windowtitle "Colour finder"
Screeninfo xres,yres 
width xres\8,yres\16
NoConsole
Dim As Ubyte r,g,b
Color ,RGB (236,233,216)
Dim As screenpoint m
dim as string key,s="  " +chr(13)+chr(10),msg 
dim as integer x,y,counter
Do
    key=inkey
    if key=" "  then 
        counter+=1
        popbeep(0)
var bb=string(3-len(str(b)),"0")+str(b),rr=string(3-len(str(r)),"0")+str(r),gg=string(3-len(str(g)),"0")+str(g)
var sp=string(6-len(hex(v))," ")
        s+= "RGB (" & bb &"," & gg &"," & rr &")"+ "   HEX &h"+hex(v)+sp+"   HTML #"+HTML(v) +chr(13)+chr(10)
    end if
    _getmouse @m
    screencontrol 0,x,y
if m.x>x and m.x<x+xres and m.y>y and m.y<y+yres then msg="<space> to save a colour" else msg="" 
    Screenlock
    Cls
    Locate 1,1
    Color 0
    print "X,Y   ";str(m.x);",";str(m.y)
    Print "Red   ";b
    Print "Green ";g
    Print "Blue  ";r
    print
    locate 10,1
    print "HEX   &h";hex(v,6)
    draw string(0,180),msg,rgb(0,0,0)
    print "HTML   #";HTML(v)
    Line(100-30,100-30)-(100+30,100+30),Rgb(b,g,r),bf
    Line(100-30,100-30)-(100+30,100+30),Rgb(0,0,0),b
    v=_point(MyScreen,m.x,m.y)
    r= Cptr(Ubyte Ptr,@v)[2] 'Or just use the standard r,g,b extract method
    g= Cptr(Ubyte Ptr,@v)[1] 'but this method is a tad faster
    b= Cptr(Ubyte Ptr,@v)[0]
    Screenunlock
    Sleep 1,1
Loop Until key=Chr(255,107) or key=chr(27)
 if s<>"  " +chr(13)+chr(10) then
screen 0
showconsole
title "Colours picked  (" & counter &" colours)."
print s
var f=freefile
open "colours.txt" for output as #f
print #f,s
close #f
s=command(0)
dim as integer i=instrrev(s,"\")
s=mid(s,1,i) + "colours.txt"
print "printed to ";s
print "Press a key to exit"
sleep
end if
 
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: Colour Finder

Post by Quark »

.
@dodicat

You can't get much more responsive than that! Thank you.

Will give your new version a test drive sometime today.
.
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: Colour Finder

Post by Quark »

.
@dodicat

I tried your Colour Finder and had positive results -- the Colours.txt file is a handy repository of the selected colors -- all that is needed for coders to develop a good palette for whatever project.

Whether the console is still needed, is up to you. It is not possible to copy the info from the console in my Vista system -- don't know about other versions of Windows, except you said XP is OK for this.

FYI, when I used your program with IrfanView or with colors on my desktop, there was no problem, but oddly, when I selected colors from the QuickView in FreeCommander, there was no console, and the colours.txt was not saved. I tried this twice to make sure. More next week on 'Spooky Mysteries of the Western World'.
.
Post Reply