PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

GetPixelColour with mouse magnifier

https://www.purebasic.fr/english/viewtopic.php?t=40098

Page 1 of 2

GetPixelColour with mouse magnifier

Posted: Fri Nov 27, 2009 5:28 pm
by infratec
Hi,

from a small coding question I was inspired to make this:

Code: Select all

; Samplecode to get the color of a Pixel on the Desktop
; by PureLust for PureBasic-Forum - 18.09.2009 (with thanks to netmaestro)  ;)
; extended by infratec
; windows Vista problem solved by srod (GetPixel() is to slow in Vista ~40ms !!!)
; now works also with 7 (GetDC() and ReleaseDC() now inside the loop)
; fix for multi screen environment added
; now multi screens should really work correct
; cursor movements are now correct (relative moves goes through the driver and his acceleration)


#MOUSEEVENTF_VIRTUALDESK = $4000

Global Mag = 5
Global ImageDim
NewMag = 5
#BoxPlusMinus = 10


Procedure SetMag(NewMag.i)
 Mag = NewMag
 ImageDim = #BoxPlusMinus * 2 * Mag
 CreateImage(0, ImageDim, ImageDim)
 If ImageDim < 100
  WinDim = 100
 Else
  WinDim = ImageDim
 EndIf
 ResizeWindow(0, #PB_Ignore, #PB_Ignore, 100 + WinDim, 70 + WinDim)
 TextGadget(1, 0, 45 + WinDim, 100 + WinDim, 20, "", #PB_Text_Center)
EndProcedure



Dim SendInputData.INPUT(0)

SendInputData(0)\Type = #INPUT_MOUSE
SendInputData(0)\mi\time = 0
SendInputData(0)\mi\dwExtraInfo = 0
SendInputData(0)\mi\mouseData = 0



OpenWindow(0, 0, 0, 200, 170, "", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Minimize)

ImageGadget(0, 46, 20, 105, 105, 0, #PB_Image_Border)
TextGadget(1, 0, 145, 200, 20, "", #PB_Text_Center)
TrackBarGadget(2, 10, 20, 20, 105, 1, 9, #PB_TrackBar_Vertical)
SetGadgetState(2, 1)

BoxDim = #BoxPlusMinus * 2
ImageDim = #BoxPlusMinus * 2 * Mag

CreateImage(0, ImageDim, ImageDim)


ShortCuts = 0

Repeat
 Event = WaitWindowEvent(100)

 x.l = DesktopMouseX()
 y.l = DesktopMouseY()

 hDC.l = GetDC_(0)
 PointColor = GetPixel_(hDC, x, y)
 Red = Red(PointColor)
 Green = Green(PointColor)
 Blue = Blue(PointColor)
 PixelColour$ = RSet(Hex(Red), 2, "0") + RSet(Hex(Green), 2, "0") + RSet(Hex(Blue), 2, "0")
 
 If WindowHeight(0) > 10
 
  If ShortCuts = 0
   AddKeyboardShortcut(0, #PB_Shortcut_Left, 1)
   AddKeyboardShortcut(0, #PB_Shortcut_Up, 2)
   AddKeyboardShortcut(0, #PB_Shortcut_Right, 3)
   AddKeyboardShortcut(0, #PB_Shortcut_Down, 4)
   AddKeyboardShortcut(0, #PB_Shortcut_Add, 5)
   AddKeyboardShortcut(0, #PB_Shortcut_Subtract, 6)
   AddKeyboardShortcut(0, #PB_Shortcut_F1, 7)
   SetWindowTitle(0, "GetPixelColour")
   ShortCuts = 1
  EndIf
 
  SetGadgetText(1, "Colour at " + Str(x) + ","+ Str(y) +" is: " + PixelColour$)
 
  SD = StartDrawing(ImageOutput(0))
 
  If SD
   
   ; find out the correct screensize
   If GetSystemMetrics_(#SM_CMONITORS) = 1
    DeskWidth.l = GetSystemMetrics_(#SM_CXSCREEN)
    DeskHeight.l = GetSystemMetrics_(#SM_CYSCREEN)
    dwFlags.q = #MOUSEEVENTF_ABSOLUTE + #MOUSEEVENTF_MOVE
   Else
    DeskWidth.l = GetSystemMetrics_(#SM_CXVIRTUALSCREEN)
    DeskHeight.l = GetSystemMetrics_(#SM_CYVIRTUALSCREEN)
    dwFlags.q = #MOUSEEVENTF_ABSOLUTE + #MOUSEEVENTF_MOVE + #MOUSEEVENTF_VIRTUALDESK
   EndIf
   
   ; calculations for the 'borders'
   If x - #BoxPlusMinus < 0
    ScreenX1 = 0
    ImageX1 = (#BoxPlusMinus - x) * Mag
   Else
    ScreenX1 = x - #BoxPlusMinus
    ImageX1 = 0
   EndIf
   
   If x + #BoxPlusMinus > DeskWidth
    ImageX2 = (#BoxPlusMinus * 2 - (x + #BoxPlusMinus - DeskWidth)) * Mag
   Else
    ImageX2 = ImageDim
   EndIf
   
   If y - #BoxPlusMinus < 0
    ScreenY1 = 0
    ImageY1 = (#BoxPlusMinus - y) * Mag
   Else
    ScreenY1 = y - #BoxPlusMinus
    ImageY1 = 0
   EndIf
   
   If y + #BoxPlusMinus > DeskHeight
    ImageY2 = (#BoxPlusMinus * 2 - (y + #BoxPlusMinus - DeskHeight)) * Mag
   Else
    ImageY2 = ImageDim
   EndIf
   
   ; do the magnification
   StretchBlt_(SD, ImageX1, ImageY1, ImageDim, ImageDim, hDC, ScreenX1, ScreenY1, BoxDim, BoxDim, #SRCCOPY)
   
   ; fill the borders if neccessary
   If ImageX1 > 0
    Box(0, 0, ImageX1, ImageDim, 0)
   EndIf
   
   If ImageY1 > 0
    Box(0, 0, ImageDim, ImageY1, 0)
   EndIf
   
   If ImageX2 < ImageDim
    Box(ImageX2, 0, ImageDim - ImageX2, ImageDim, 0)
   EndIf
   
   If ImageY2 < ImageDim
    Box(0, ImageY2, ImageDim, ImageDim - ImageY2, 0)
   EndIf
   
   
   ; draw the crosshairs
CompilerIf #PB_Compiler_Version >= 440
   Line((ImageDim + Mag) / 2, 0, 1, ImageDim + Mag , ~PointColor)
   Line(0, (ImageDim + Mag) / 2, ImageDim + Mag, 1 , ~PointColor)
CompilerElse
   PointColor = $FFFFFF - PointColor
   Line((ImageDim + Mag) / 2, 0, 0, ImageDim + Mag , PointColor)
   Line(0, (ImageDim + Mag) / 2, ImageDim + Mag, 0 , PointColor)
CompilerEndIf

   StopDrawing()
   SetGadgetState(0, ImageID(0))
  EndIf
 
  If Event = #PB_Event_Gadget
   If EventGadget() = 2
    NewMag = 4 + (GetGadgetState(2) * 2 - 1)
    If Mag <> NewMag
     SetMag(NewMag)
    EndIf
   EndIf
  EndIf
 
  If Event = #PB_Event_Menu
   
   SendInputData(0)\mi\dwFlags = dwFlags
   
   Select EventMenu()
    Case 1:
;     mouse_event_(1, -1, 0, 0, 0)
     SendInputData(0)\mi\dx = Round((65536.0 * (x - 1) / DeskWidth), #PB_Round_Up)
     SendInputData(0)\mi\dy = Round((65536.0 * y) / DeskHeight, #PB_Round_Up)
     SendInput_(1, SendInputData(0), SizeOf(INPUT))
    Case 2:
     ;mouse_event_(1, 0, -1, 0, 0)
     SendInputData(0)\mi\dx = Round((65536.0 * x) / DeskWidth, #PB_Round_Up)
     SendInputData(0)\mi\dy = Round((65536.0 * (y - 1)) / DeskHeight, #PB_Round_Up)
     SendInput_(1, SendInputData(0), SizeOf(INPUT))
    Case 3:
     ;mouse_event_(1, 1, 0, 0, 0)
     SendInputData(0)\mi\dx = Round((65536.0 * (x + 1)) / DeskWidth, #PB_Round_Up)
     SendInputData(0)\mi\dy = Round((65536.0 * y) / DeskHeight, #PB_Round_Up)
     SendInput_(1, SendInputData(0), SizeOf(INPUT))
    Case 4:
     ;mouse_event_(1, 0, 1, 0, 0)
     SendInputData(0)\mi\dx = Round((65536.0 * x) / DeskWidth, #PB_Round_Up)
     SendInputData(0)\mi\dy = Round((65536.0 * (y + 1)) / DeskHeight, #PB_Round_Up)
     SendInput_(1, SendInputData(0), SizeOf(INPUT))
    Case 5:     
     If Mag < 21
      Mag + 2
      SetMag(Mag)
      SetGadgetState(2, (Mag - 3) / 2 )
     EndIf     
    Case 6:
     If Mag > 5
      Mag - 2
      SetMag(Mag)
      SetGadgetState(2, (Mag - 3) / 2 )
     EndIf
    Case 7:
     Text$ = "                  Getpixelcolour" + Chr(13)
     Text$ + Chr(13)
     Text$ + "                 2009 by Infratec" + Chr(13)
     Text$ + Chr(13)
     Text$ + "Use the cursor keys for fine adjustment" + Chr(13)
     Text$ + "Plus and minus to set the magnification" + Chr(13)
     Text$ + Chr(13)
     Text$ + "                      Have fun!"
     MessageRequester("Info", Text$)
   EndSelect
  EndIf
 
 Else
  SetWindowTitle(0, PixelColour$)
  If ShortCuts = 1
   RemoveKeyboardShortcut(0, #PB_Shortcut_All)
   ShortCuts = 0
  EndIf
 EndIf

 ReleaseDC_(0,hDC)

Until Event = #PB_Event_CloseWindow
I hope all bugs are fixed.

I found it usefull, since I have often to do some html stuff,
and all other solutions are much bigger in size.

Bernd

Re: GetPixelColour with mouse magnifier

Posted: Fri Nov 27, 2009 6:36 pm
by +18
Very cool, merci :D

Re: GetPixelColour with mouse magnifier

Posted: Fri Nov 27, 2009 9:33 pm
by netmaestro
Very nice little handy tool. Now a little challenge for you: It would be easier to use if it had keyboard control as well, so that one press of the up arrow would move your mouse pointer exactly one pixel and same for the other 3 directions. This would give you finetuned control when you're close to what you want.

Re: GetPixelColour with mouse magnifier

Posted: Fri Nov 27, 2009 9:40 pm
by srod
Crashes here on Vista if I activate the window and then try and close it.

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 12:00 am
by infratec
@netmaestro
since christmas is near, I fullfilled your wish.
Now you can use the cursorkeys for fine tuning.


@srod
Hm, at the moment I have no access to Vista.
But I'll test it asap. At the moment I have no idea what can be the reason.

Bernd

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 12:42 am
by Arctic Fox
I think the problem lies in Color = GetPixel_(hDC, x1, y1) on line number 45. No problems occur here on Vista when commenting it out.

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 12:04 pm
by srod
Yes, GetPixel_() is horrendously slow when working with a desktop DC on Vista and the problem is that it is all 'backing up'. Simple tests have confirmed this. Switch to a normal window DC and everything runs much better.

If I were you I would dump a copy of the desktop to a memory DC holding an image and then work with that - or find some other way.

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 1:49 pm
by srod
@infratec : here's something which I knocked up in a couple of minutes and which works fine here on Vista. You might want to play with it?

Code: Select all

OpenWindow(0, 0, 0, 200, 170, "", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)

ImageGadget(0, 46, 20, 105, 105, 0, #PB_Image_Border)
TextGadget(1, 0, 145, 200, 20, "", #PB_Text_Center)

CreateImage(0, 105, 105)

HDC = GetDC_(0)

AddWindowTimer(0, 100, 10)

Repeat
  Event = WaitWindowEvent()
  If Event = #PB_Event_Timer And EventTimer() = 100
    x = DesktopMouseX()
    y = DesktopMouseY()
    PointColor = GetPixel_(hDC, x, y)
    SetWindowTitle(0, Hex(PointColor))
    hdcImage = StartDrawing(ImageOutput(0))
    If hdcImage
      x - 10
      If x < 0 : x = 0 : EndIf
      y - 10
      If y < 0 : y = 0 : EndIf
      StretchBlt_(hdcImage, 0, 0, 105, 105, hdc, x, y, 20, 20, #SRCCOPY)
      StopDrawing()
      SetGadgetState(0, ImageID(0))
    EndIf
  EndIf 
Until Event = #PB_Event_CloseWindow

ReleaseDC_(0,HDC)

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 1:50 pm
by infratec
It's right.

With XP it takes 0 ms for one GetPixel(),
with Vista it takes between 30 and 40 ms.

With 20 by 20 requests, this takes 16s :!:

What a m...!

I try to solve this.

Bernd

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 1:51 pm
by infratec
@srod

Thank's, I'll try it.

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 2:31 pm
by Kwai chang caine
Very usefull !!!
Thanks at you two 8)

You have always somme code for open my eyes like that :shock:

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 5:50 pm
by infratec
Hi together,

I don't like wind... :!:

And normally I avoid all that API stuff, so I say thank you to srod for his hint.
He also pointed out an other problem of my program:
The 'border' problem.

This was a hard work for my brain, but now it is fixed.
So now you can also investigate the borders.

Also with Vista and maybe also with 7 (not tested, since I have no 7)

Have fun,

Bernd

P.S.: It is already prepared for a slider where you can change the magnification.
the next step of the evolution :mrgreen:

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 6:43 pm
by infratec
Hi,

now also with a magnification slider :mrgreen: :mrgreen: :mrgreen:

Bernd

Re: GetPixelColour with mouse magnifier

Posted: Sat Nov 28, 2009 11:59 pm
by srod
Works well infratec; very nice. 8)

Re: GetPixelColour with mouse magnifier

Posted: Sun Nov 29, 2009 1:57 am
by Rook Zimbabwe
Extermely cool! 8)
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited