Color Eyedropper

Share your advanced PureBasic knowledge/code with the community.
chris319
Enthusiast
Enthusiast
Posts: 782
Joined: Mon Oct 24, 2005 1:05 pm

Color Eyedropper

Post by chris319 »

Here is a color "eyedropper" for displaying the RGB values of any pixel on the screen. Feel free to add enhancements. Many thanks to Franco and anyone else who contributed.

Code: Select all

;Original loupe code by Franco
#WI = 1:#HE=1
    Procedure CaptureScreen(Left.l, Top.l)
      DC = GetDC_(0)
      MemDC = CreateCompatibleDC_(DC)
      BmpID = CreateImage(0, #WI, #HE)
      SelectObject_( MemDC, BmpID)
      StretchBlt_( MemDC, 0, 0,#WI,#HE, DC,Left, Top, #WI, #HE, #SRCCOPY)
      DeleteDC_( MemDC)
      ReleaseDC_(0,DC)
      ProcedureReturn BmpID
    EndProcedure
    
    If OpenWindow(0,0,0,200,200,"R G B",#PB_Window_SystemMenu)
    StickyWindow(0,#True)
    Else : End : EndIf
    
    CursorPosition.POINT
    StartDrawing(WindowOutput(0))

    Repeat
      EventID = WaitWindowEvent(10)
      GetCursorPos_(CursorPosition)
      hImage = CaptureScreen(CursorPosition\x,CursorPosition\y)
      DrawImage(hImage, 0, 0,#WI,#HE)
re = Red(Point(0,0)):DrawText(25,15,"Red:      "+Str(re)+"     "+LCase(Hex(re))+"       ",#White,$0000aa)
gr = Green(Point(0,0)):DrawText(25,35,"Green: "+Str(gr)+"     "+LCase(Hex(gr))+"       ",#White,$00aa00)
bl = Blue(Point(0,0)):DrawText(25,55,"Blue:     "+Str(bl)+"     "+LCase(Hex(bl))+"       ",#White,$ff0000)
Box(45,90,100,100,RGB(re,gr,bl))
    Until EventID=#PB_Event_CloseWindow   

    End
juror
Enthusiast
Enthusiast
Posts: 232
Joined: Mon Jul 09, 2007 4:47 pm
Location: Courthouse

Re: Color Eyedropper

Post by juror »

Nice, compact, useful.

Thx for sharing.
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Color Eyedropper

Post by IdeasVacuum »

...a bit complicated?

Try this (Windows only :? ) , spans all monitors :)

Code: Select all

Enumeration
#WinMain
EndEnumeration

Global igPt.point, igEvent.i, igColour.i, sgColour.s

       If OpenWindow(#WinMain, 0, 0, 200, 0,"RGB", #PB_Window_SystemMenu | #PB_Window_Tool)

             StickyWindow(#WinMain, #True)

             hDC = GetDC_(#WinMain)

             Repeat
                       igEvent = WaitWindowEvent(20)

                      GetCursorPos_(@igPt)

                      igColour = GetPixel_(hDC, igPt\x, igPt\y)
                      sgColour = "RGB(" + Str(Red(igColour)) + "," + Str(Green(igColour)) + "," + Str(Blue(igColour)) + ")"

                      If(GetAsyncKeyState_(#VK_SPACE) & 32768) ;Space Bar

                              SetClipboardText(sgColour)
                      EndIf

                      SetWindowTitle(#WinMain, sgColour)

             Until (igEvent = #PB_Event_CloseWindow)
       EndIf

End
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
infratec
Always Here
Always Here
Posts: 7620
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Color Eyedropper

Post by infratec »

Hi,

old, but with a bit more comfort:
http://www.purebasic.fr/english/viewtop ... 14&t=40098

Bernd
chris319
Enthusiast
Enthusiast
Posts: 782
Joined: Mon Oct 24, 2005 1:05 pm

Re: Color Eyedropper

Post by chris319 »

I think it's a nice touch for the user to see the actual color being measured, and the hex output is useful to me. I may add YUV output as well. I'm doing some critical color evaluation with this and it's worked quite well for that.
Post Reply