Author |
Topic: A quick way to sample pixels in Windows 7? (Read 4024 times) |
|
sbracken
New Member
member is offline
Posts: 19
|
 |
A quick way to sample pixels in Windows 7?
« Thread started on: Mar 10th, 2014, 1:25pm » |
|
I have just upgraded two different laptops to Windows 7 and have run into an issue with one of my programs. It is based on the code Richard posted many moons ago on the Yahoo site to sample the colour of any pixel on screen:
https://groups.yahoo.com/neo/groups/bb4w/conversations/messages/3027
I have expanded this to show a magnified view of what is being pointed to, as well as a rectangle filled with the colour of the current pixel. A cut down version is listed below. The actual program adds a measuring tool and way to grab parts of the screen to either a file or the clipboard.
Code:
VDU 23,22,228;156;8,16,16,0
OFF
COLOUR 15,236,233,216
COLOUR 1,236,233,216
GCOL0,128+1:CLG
DIM pt{x%,y%}
oldx%=0
oldy%=0
r%=0
g%=0
b%=0
step%=11
side%=24
GCOL0,0
RECTANGLE FILL side%-4,side%-4,(side%*step%)+8,(side%*step%)+8
RECTANGLE FILL 304,160,132,132
SYS "CreateDC", "DISPLAY", 0, 0, 0 TO hdc%
REPEAT
WAIT 1
MOUSE X%,Y%,B%
IF (X%<>oldx% OR Y%<>oldy%) THEN
SYS "GetCursorPos", pt{}
*REFRESH OFF
px%=0
py%=step%-1
FOR x%=pt.x%-INT(step%/2) TO pt.x%+INT(step%/2)
FOR y%=pt.y%-INT(step%/2) TO pt.y%+INT(step%/2)
SYS "GetPixel", hdc%, x%, y% TO rgb%
r%=rgb% AND 255
g%=(rgb% >> 8) AND 255
b%=(rgb% >> 16) AND 255
COLOUR1,r%,g%,b%
GCOL0,1
RECTANGLE FILL (px%+1)*side%,(py%+1)*side%,side%,side%
IF px%=INT(step%/2) AND py%=INT(step%/2) THEN
RECTANGLE FILL 308,164,124,124
SYS "SetWindowText", @hwnd%, STRING$(3-LEN(STR$(r%))," ")+STR$(r%)+" "+STRING$(3-LEN(STR$(g%))," ")+STR$(g%)+" "+STRING$(3-LEN(STR$(b%))," ")+STR$(b%)
ENDIF
py%-=1
NEXT y%
px%+=1:py%=step%-1
NEXT x%
GCOL4,0
RECTANGLE side%*(INT(step%/2)+1),side%*(INT(step%/2)+1),side%+1,side%+1
*REFRESH ON
*REFRESH
oldx%=X%
oldy%=Y%
ENDIF
UNTIL FALSE
QUIT
This ran fine on Windows XP on a number of different machines, including a piece of equipment running an embedded version. Sadly, on every Windows 7 machine I have tried (32 and 64 bit), it is too slow to actually use easily. The Proflier utility suggested that using GetPixel was the problem - something confirmed by a quick google search. I have tried reading up on alternative methods, but have quickly found myself way out of my depth.
Is there a simple way of improving performance on Windows 7? Some pointers to alternative methods would be appreciated, as this has already proven to be a very useful little utility. The alternative will simply be to remove the magnified view, and call GetPixel once each time the mouse is moved.
Thanks,
Simon
|
| « Last Edit: Mar 10th, 2014, 4:12pm by sbracken » |
 Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #1 on: Mar 10th, 2014, 2:11pm » |
|
on Mar 10th, 2014, 1:25pm, sbracken wrote:| I have expanded this to show a magnified view of what is being pointed to |
|
There's a Liberty BASIC program which does this, and which seems to work reasonably well on Windows 8.1; it's called 'Zoomer4.bas'. You could adapt that, or you could leave it as Liberty BASIC code and compile it with 'LB Booster' (or even extract the BBC BASIC code from LBB's translation, but that might not be any easier than translating it manually).
I've listed the LB program below (apologies to BBC BASIC 'purists' who don't think this is an appropriate place for it). Sadly, even by LB's standards, it's a poorly-structured program because it uses GOSUB/RETURN rather than SUB/END SUB. Whether translated to BBC BASIC or not, it would benefit from a re-write.
Richard.
Code:'ORIGINAL in LB 2.02 - 29 Oct 98
'Subject: sight project... 2910SW1-
'From: Tom Record
'Improved by Richard Russell - 09 Oct 2011
' Rick's zoom.bas
dim Zoom$(15)
For x=5 to 20
Zoom$(x-5)=str$(x)
Next x
m = 38 'magnification
struct point, x as long, y as long
WindowWidth = 264
WindowHeight = 226
nomainwin
graphicbox #main.Zoom, 54, 4, 200, 200
listbox #main.ZoomType, Zoom$(, [ZoomSize], 8, 4, 44, 148
button #main.Quit, "Quit", [Quit], UL, 8, 156, 44, 30
open "Zoomer" for window_nf as #main
print #main, "trapclose [Quit]"
#main.ZoomType, "singleclickselect"
calldll #user32, "GetDesktopWindow",_
CTFrom as long
calldll #user32, "GetDC",_
CTFrom as long,_
HdcFrom as long
CTTo=hwnd(#main.Zoom)
calldll #user32, "GetDC",_
CTTo as long,_
HdcTo as long
timer 20, [main.inputLoop]
wait
[main.inputLoop] 'wait here for input event
gosub [TryPointer]
wait
[Quit]
calldll #user32, "ReleaseDC",_
CTFrom as long,_
HdcFrom as long,_
Ignored as long
calldll #user32, "ReleaseDC",_
CTTo as long,_
HdcTo as long,_
Ignored as long
close #main
end
[ZoomSize]
'Perform action for the listbox named 'ZoomType'
#main.ZoomType "selectionindex? f"
' notice f;" ";39-f
m = 39 - f
#main.Zoom "cls"
goto [main.inputLoop]
[Stretch]
calldll #gdi32,"StretchBlt",_
HdcTo as long,_
PutToX as long,_
PutToY as long,_
PutWidth as long,_
PutHeight as long,_
HdcFrom as long,_
CutFromX as long,_
CutFromY as long,_
CutWidth as long,_
CutHeight as long,_
13369376 as ulong,_
r as boolean
return
[TryPointer]
calldll #user32, "GetCursorPos", _
point as struct, _
result as long
CutFromX = point.x.struct-int(m/2)
CutFromY = point.y.struct-int(m/2)
PutToX=0 : PuToY=0 : PutWidth=200 : PutHeight=200
CutWidth=m: CutHeight=m
gosub [Stretch]
Return
|
|
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #2 on: Mar 10th, 2014, 2:47pm » |
|
Thanks Richard. I will see if I can decypher what this program does and adapt it to BB4W. This may take a while as I have no experience of Liberty BASIC beyond downloading, but never actually using, the demo a few years ago.
Time to read up on StretchBlt...
Simon
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #3 on: Mar 10th, 2014, 3:00pm » |
|
on Mar 10th, 2014, 2:47pm, sbracken wrote:| This may take a while as I have no experience of Liberty BASIC |
|
In case it helps, I've listed below LBB's translation into BBC BASIC. You should probably ignore the calls into LBLIB because you won't want to use that in your version.
Richard.
Code: REM Automatically translated from Liberty BASIC to BBC BASIC
REM by 'LB Booster' version 2.51, Mon. 10 Mar 2014, 14:54:28
REM!Crunch spaces,rems
REM!Embed @lib$+"LBLIB.BBCC", @lib$+"LBprompt.tpl"
HIMEM = PAGE + 100000000 : INSTALL @lib$ + "LBLIB.BBCC"
PROC_LBinit:Version$ = "4.04 (LBB 2.51)":erl%=0:lc%=0:io&=&F
1 REM ORIGINAL in LB 2.02 - 29 Oct 98
2 REM Subject: sight project... 2910SW1-
3 REM From: Tom Record
4 REM Improved by Richard Russell - 09 Oct 2011
5
6 REM Rick's zoom.bas
7 PROC_dim1d$(Zoom$(), 15)
8 FOR x = 5 TO 20
9 Zoom$(x - 5) = FN_str$(x)
10 NEXT x
11 m = 38 : REM magnification
12 DIM point{x%, y%} : PROC_clearstruct(point{})
13
14 WindowWidth = 264
15 WindowHeight = 226
16 SYS "ShowWindow", @hwnd%, 0
17
18 PROC_graphicbox(`main, `main`Zoom, "#main.Zoom", 54, 4, 200, 200)
19 PROC_listbox(`main, `main`ZoomType, "#main.ZoomType", ^Zoom$(), (ZoomSize_), 8, 4, 44, 148)
20 PROC_button(`main, `main`Quit, "#main.Quit", "Quit", (Quit_), "UL", 8, 156, 44, 30)
21 PROC_open("Zoomer", "window_nf", "#main", `main)
22 PROC_gui(`main, "trapclose [Quit]")
23 PROC_gui(`main`ZoomType, "singleclickselect")
24
25 SYS "GetDesktopWindow" TO CTFrom
27
28 HdcFrom = FN_getdc(FN_32(CTFrom))
31
32 CTTo = !`main`Zoom
33 HdcTo = FN_getdc(FN_32(CTTo))
36
37 PROC_timer(20, (main`inputLoop_))
38 PROC_wait
39
40 (main`inputLoop_) : REM wait here for input event
41 GOSUB (TryPointer_)
42 PROC_wait
43
44 (Quit_)
45 Ignored = FN_releasedc(FN_32(CTFrom), FN_32(HdcFrom))
49
50 Ignored = FN_releasedc(FN_32(CTTo), FN_32(HdcTo))
54
55 PROC_close(`main)
56 PROC_end
57
58 (ZoomSize_)
59 REM Perform action for the listbox named 'ZoomType'
60 PROC_gui(`main`ZoomType, "selectionindex? f")
61 REM notice f;" ";39-f
62 m = 39 - f
63 PROC_gui(`main`Zoom, "cls")
64 GOTO (main`inputLoop_)
65
66 (Stretch_)
67 SYS "StretchBlt", FN_32(HdcTo), FN_32(PutToX), FN_32(PutToY), FN_32(PutWidth), FN_32(PutHeight), FN_32(HdcFrom), FN_32(CutFromX), FN_32(CutFromY), FN_32(CutWidth), FN_32(CutHeight), 13369376, @memhdc% TO r : r = -(r <> 0)
80 RETURN
81
82 (TryPointer_)
83 SYS "GetCursorPos", point{} TO result
86
87 CutFromX = point.x% - FN_int(m / 2)
88 CutFromY = point.y% - FN_int(m / 2)
89
90 PutToX = 0 : PuToY = 0 : PutWidth = 200 : PutHeight = 200
91 CutWidth = m : CutHeight = m
92 GOSUB (Stretch_)
93 RETURN
|
|
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #4 on: Mar 10th, 2014, 4:47pm » |
|
Hi Richard,
Even better - the translated code looks much more friendly! Thanks again for your help.
I have now had a chance to try the original code you posted with LBB and it does indeed work well on Windows 7.
Simon
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #5 on: Mar 10th, 2014, 6:03pm » |
|
on Mar 10th, 2014, 4:47pm, sbracken wrote:| I have now had a chance to try the original code you posted with LBB and it does indeed work well on Windows 7. |
|
Windows 7 isn't too much of a challenge - my Magnifying Glass program runs acceptably by virtue of temporarily disabling the Desktop Window Manager (magglass.exe here); you're welcome to have the source code of that. But Windows 8/8.1 is a different matter; you can't disable the DWM and the magnifying glass program doesn't work at all. 
The LB program doesn't attempt to be so ambitious, so runs OK on all versions of Windows.
Richard.
|
|
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #6 on: Mar 10th, 2014, 7:57pm » |
|
Quote:| ...my Magnifying Glass program runs acceptably by virtue of temporarily disabling the Desktop Window Manager... |
|
I had tried your Magnifying Glass program before, but I somehow failed to notice the change in the desktop, and the warning that accompanies it!
Thank you for the offer of the source code. I may take you up on this, but I will have a go at using StretchBlt first.
Simon
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #7 on: Mar 11th, 2014, 11:59am » |
|
on Mar 10th, 2014, 7:57pm, sbracken wrote:| I had tried your Magnifying Glass program before |
|
I was looking at the 'Magnification API' as a possible way of making the Magnifying Glass program work in Windows 8/8.1, when I found this on MSDN:
"The Magnification API is not supported under WOW64; that is, a 32-bit magnifier application will not run correctly on 64-bit Windows."
That is very bad; I wonder how Microsoft can justify it.
Edit: Further Googling reveals that it's a bug in the Magnification DLL (an internal handle being declared as signed rather than unsigned), which - rather than being fixed - Microsoft have decided to 'document away' by means of the above caveat. I'm not a Microsoft hater - far from it - but I can understand the anger caused when they do something so idiotic.
Richard.
|
| « Last Edit: Mar 11th, 2014, 12:10pm by admin » |
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #8 on: Mar 11th, 2014, 3:17pm » |
|
I have now managed to get StretchBlt to work, and much to my own amazement it proved to be pretty staight forward. It would certainly have taken longer if I only had the Liberty BASIC original to work form, so many thanks again, Richard.
Code:
VDU 23,22,228;156;8,16,16,0
OFF
COLOUR 15,236,233,216
COLOUR 1,236,233,216
GCOL0,128+1:CLG
DIM pt{x%,y%}
oldx%=0
oldy%=0
r%=0
g%=0
b%=0
step%=11
side%=24
GCOL0,0
RECTANGLE FILL side%-4,side%-6,(side%*step%)+8,(side%*step%)+8
RECTANGLE FILL 304,160,132,132
SYS "GetDesktopWindow" TO dtw%
SYS "GetDC", dtw% TO hdc%
SYS "GetDC", @hwnd% TO mag%
ON CLOSE SYS "ReleaseDC", hdc%:SYS "ReleaseDC", mag%:QUIT
REPEAT
WAIT 1
MOUSE X%,Y%,B%
IF (X%<>oldx% OR Y%<>oldy%) THEN
SYS "GetCursorPos", pt{}
SYS "GetPixel", hdc%, pt.x%, pt.y% TO rgb%
r%=rgb% AND 255
g%=(rgb% >> 8) AND 255
b%=(rgb% >> 16) AND 255
COLOUR1,r%,g%,b%
GCOL0,1
RECTANGLE FILL 308,164,124,124
SYS "SetWindowText", @hwnd%, STRING$(3-LEN(STR$(r%))," ")+STR$(r%)+" "+STRING$(3-LEN(STR$(g%))," ")+STR$(g%)+" "+STRING$(3-LEN(STR$(b%))," ")+STR$(b%)
magX%=pt.x%-INT(step%/2)
magY%=pt.y%-INT(step%/2)
SYS "StretchBlt", mag%, side%/2, side%/2, (side%*step%)/2, (side%*step%)/2, hdc%, magX%, magY%, step%, step%, 13369376, @memhdc% TO r%
GCOL4,0
RECTANGLE side%*(INT(step%/2)+1)-2,side%*(INT(step%/2)+1)-2,side%+2,side%+2
oldx%=X%
oldy%=Y%
ENDIF
UNTIL FALSE
QUIT
The only issue remaining is the inversely plotted rectangle that is supposed to frame the central pixel in the magnification box. It does not work properly, presumably because BB4W doesn't know what has been put there by the call to StretchBlt. My solution has been to simply draw a filled rectangle in the centre of the magnification box myself and then invert its edge, replacing
Code:
GCOL4,0
RECTANGLE side%*(INT(step%/2)+1)-2,side%*(INT(step%/2)+1)-2,side%+2,side%+2
with
Code:
GCOL0,1
RECTANGLE side%*(INT(step%/2)+1),side%*(INT(step%/2)+1),side%,side%
GCOL4,0
RECTANGLE side%*(INT(step%/2)+1),side%*(INT(step%/2)+1),side%,side%
but is there a better way?
Simon
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #9 on: Mar 11th, 2014, 4:05pm » |
|
on Mar 11th, 2014, 3:17pm, sbracken wrote:| I have now managed to get StretchBlt to work, and much to my own amazement it proved to be pretty staight forward. |
|
It's not working properly. You are plotting directly to the screen, not to BB4W's output bitmap, which means the two will be fighting each other! The most obvious symptom is the failure of your 'inverse' rectangle, but it's the wrong way to go about things.
Effectively you have tried to reproduce the way the Liberty BASIC program works in 'real' LB 4.04, not the way it works in LB Booster. If you look at the LBB translation you will see that the code doesn't actually call the Windows GetDC API function at all, but the function FN_getdc in LBLIB (which returns the DC of the output bitmap).
To fix this you need to get rid of all references to mag%, which is the screen DC and therefore something that you should not be touching, and replace it with @memhdc% as follows:
Code: VDU 23,22,228;156;8,16,16,0
OFF
COLOUR 15,236,233,216
COLOUR 1,236,233,216
GCOL0,128+1:CLG
DIM pt{x%,y%}
oldx%=0
oldy%=0
r%=0
g%=0
b%=0
step%=11
side%=24
GCOL0,0
RECTANGLE FILL side%-4,side%-6,(side%*step%)+8,(side%*step%)+8
RECTANGLE FILL 304,160,132,132
SYS "GetDesktopWindow" TO dtw%
SYS "GetDC", dtw% TO hdc%
ON CLOSE SYS "ReleaseDC", hdc%:QUIT
REPEAT
WAIT 1
MOUSE X%,Y%,B%
IF (X%<>oldx% OR Y%<>oldy%) THEN
SYS "GetCursorPos", pt{}
SYS "GetPixel", hdc%, pt.x%, pt.y% TO rgb%
r%=rgb% AND 255
g%=(rgb% >> 8) AND 255
b%=(rgb% >> 16) AND 255
COLOUR1,r%,g%,b%
GCOL0,1
RECTANGLE FILL 308,164,124,124
SYS "SetWindowText", @hwnd%, STRING$(3-LEN(STR$(r%))," ")+STR$(r%)+" "+STRING$(3-LEN(STR$(g%))," ")+STR$(g%)+" "+STRING$(3-LEN(STR$(b%))," ")+STR$(b%)
magX%=pt.x%-INT(step%/2)
magY%=pt.y%-INT(step%/2)
SYS "StretchBlt", @memhdc%, side%/2, side%/2, (side%*step%)/2, (side%*step%)/2, hdc%, magX%, magY%, step%, step%, 13369376, @memhdc% TO r%
SYS "InvalidateRect", @hwnd%, 0, 0
GCOL4,0
RECTANGLE side%*(INT(step%/2)+1)-2,side%*(INT(step%/2)+1)-2,side%+2,side%+2
oldx%=X%
oldy%=Y%
ENDIF
UNTIL FALSE
QUIT
Richard.
|
|
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #10 on: Mar 11th, 2014, 5:24pm » |
|
Thanks for the correction. I tried to find LBLIB to better understand the translation, but all my searching came up blank. It is not in the Files area of the Yahoo group, for example, although LBprompt.tpl is.
Although it is not relevant for my program, I was curious about another aspect of the translation: Zoom$(15) is dimensioned by a call to PROC_dim1d$ rather than a DIM statement. Is there another BB4W/LB difference here?
Simon
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #11 on: Mar 11th, 2014, 5:59pm » |
|
on Mar 11th, 2014, 5:24pm, sbracken wrote:| I tried to find LBLIB to better understand the translation, but all my searching came up blank. It is not in the Files area of the Yahoo group |
|
It is in the Files area of the LBB Yahoo group, but it's called LBLIB.BBCC (note the unusual extension):
https://groups.yahoo.com/neo/groups/lbb/files
But since it's a 'crunched' library it's hard to read and I wouldn't necessarily have expected you to look at it. I probably should have drawn your attention to the fact that you would need to use @memhdc% as the 'destination' DC. It's the old problem of not knowing what you don't know!
Quote:| Is there another BB4W/LB difference here? |
|
Not in that particular program, no; if you were to trace through PROC_dim1d$ you would find that in fact it just does a conventional DIM.
The issue arises if a program DIMs (or REDIMs; in LB they are synonymous) that same array again. In BBC BASIC that would simply give rise to a 'Bad DIM' error so the procedure in LBLIB checks to see if the array was previously defined and if so avoids generating the error.
Richard.
|
|
Logged
|
|
|
|
sbracken
New Member
member is offline
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #12 on: Mar 11th, 2014, 7:49pm » |
|
on Mar 11th, 2014, 5:59pm, Richard Russell wrote:It's the old problem of not knowing what you don't know!
|
|
Indeed, I often don't know what I don't know!
Thanks again for the help. Now to update the full version of my program to work with StretchBlt...
Simon
|
|
Logged
|
|
|
|
RNBW
New Member
member is offline
Gender: 
Posts: 19
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #13 on: Jan 7th, 2015, 4:21pm » |
|
I've tried finding LBLIB.BBCC in the files area and I can't find it either. It might be a mystery to me, but I'd like to have a look at it.
|
|
Logged
|
|
|
|
rtr2
Guest
|
|
Re: A quick way to sample pixels in Windows 7?
« Reply #14 on: Jan 7th, 2015, 5:18pm » |
|
on Jan 7th, 2015, 4:21pm, RNBW wrote:| I've tried finding LBLIB.BBCC in the files area and I can't find it either. |
|
I'm mystified by that. I just clicked on the link I published in my earlier reply, and there was LBLIB.bbcc as the very first file listed!
Of course you'll need to be a member of that group before you can see the contents of its Files area; is it possible you neglected to join the group before looking there?
Richard.
|
|
Logged
|
|
|
|
|
