Problem with the GetPixel() function! Need help please!

[vbzero]

The Project's code:


Form:

-------------------

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Dim PicPixelA As Long
Dim PicPixelB As Long
Dim x As Long, y As Long
Dim xp As Long, yp As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Dim DesktopWindow As Long

Private Declare Function GetDC Lib "user32" (ByVal HWND As Long) As Long

Private Sub CompareButton_Click()
On Error Resume Next
CompareButton.Enabled = False
DesktopWindow = GetDesktopWindow
Dim FoundIt As Boolean
FoundIt = False
PicPixelA = GetPixel(PictureBox.hdc, 0, 0)
For x = 0 To Screen.Width - PictureBox.Width
For y = 0 To Screen.Height - PictureBox.Height
PicPixelB = GetPixel(GetDC(DesktopWindow), x, y)
If PicPixelA = PicPixelB Then
FoundIt = True
For xp = 0 To PictureBox.Width
For yp = 0 To PictureBox.Height
PicPixelA = GetPixel(PictureBox.hdc, xp, yp)
PicPixelB = GetPixel(GetDC(DesktopWindow), x + xp, y + yp)
If PicPixelA <> PicPixelB Then
FoundIt = False
xp = PictureBox.Width
yp = PictureBox.Height
End If
Next yp
Next xp
If FoundIt Then
MsgBox "A match was found. The pictures are the same.", vbInformation, "Match found"
CompareButton.Enabled = True
Exit Sub
End If
End If
Next y
Next x
MsgBox "The pictures didn't match at this try.", vbInformation, "No match found"
CompareButton.Enabled = True
Exit Sub
End Sub

Private Sub ExitButton_Click()
On Error Resume Next
End
End Sub

Private Sub Form_Load()
On Error Resume Next
SetCloseButton Me, False
Call SetWindowPos(Me.HWND, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub

-------------------

Module:

-------------------

Option Explicit

Public Declare Function GetSystemMenu Lib "user32" _
(ByVal HWND As Long, ByVal bRevert As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" _
(ByVal H_MENU As Long) As Long
Public Declare Function RemoveMenu Lib "user32" _
(ByVal H_MENU As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal HWND As Long) As Long

Public Const MF_BYPOSITION = &H400&
Public Const MF_REMOVE = &H1000&

Public Declare Function SetWindowPos _
Lib "user32" (ByVal HWND As Long, ByVal _
hWndInsertAfter As Long, ByVal x As Long _
, ByVal y As Long, ByVal cx As Long, ByVal _
cy As Long, ByVal wFlags As Long) As Long

Public Const HWND_TOPMOST As Long = -1
Public Const SWP_NOSIZE As Long = &H1
Public Const SWP_NOMOVE As Long = &H2

Public Sub SetCloseButton(T_FORM As Form, Disabled As Boolean)
On Error Resume Next
Dim H_MENU As Long
Dim N_COUNT As Long
If Not Disabled Then
H_MENU = GetSystemMenu(T_FORM.HWND, 0)
N_COUNT = GetMenuItemCount(H_MENU)
Call RemoveMenu(H_MENU, N_COUNT - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(H_MENU, N_COUNT - 2, MF_REMOVE Or MF_BYPOSITION)
DrawMenuBar T_FORM.HWND
Else
H_MENU = GetSystemMenu(T_FORM.HWND, True)
DrawMenuBar T_FORM.HWND
End If
End Sub

-------------------

This should search the desktop for a picture. The program
compares every line and every pixel with the other one
and if there's a match it would send a message.

There must be an error anywhere because even when I remove
the line "On Error Resume Next" the program doesn't respond
after a while.

I built in a counter once to view if the application is
working. This was successfull until the moment the counter
got an internal overflow. The time which was taken for that
was about 5 minutes and about 1% of work was done.
I think it would take hours to search and compare any
pixel on the screen. Is there any other way?
Which solution would be the best here?

I heard something bout a BitBlt() function. Does anyone
know this function and can tell me what it is good for?
Can I use it for my application?

-------------------

thx, sub-zero


Visual Studio 6.0 Enterprise Edition - SP3

[Sam Finch]

Hi, If you're doing what I think you're doing I might have thought of a way of doing it. but I'm having trouble reading the code and as it's the whole project's code It seems to be doing several different things.

I can't write the code or explain the Idea right now as I have to go outside into the real world (scary I know)

Is this what you're trying to do.


Have the user put a picture into a picture box


Try to find a rectangle on the screen sutch that the image in the rectangle matches EXACTLY the picture in the picturebox.

If this is what you're doing put a post up, I think I might be able to help.


OK, Time to face the outside world.

[vbzero]

OK - What I'm trying to do is:

There is a picture defined in a piture box of a form.
The program should find that picture anywhere on the
screen. This has to match exactly.

That means: If there exists an exact copy of the
picture in the picture box on the screen, the program
has to find it and if there's a match, to send a
message.

At the part where the message would appear, I'll write
some code to move the mouse cursor into the middle of
the picture. - But for that I know the code allready.

I explained this routines in the code above.
Maybe there's any other way?
Perhaps there can be used arrays? Or is there anything
with the BitBlt() function?

thx, sub-zero


Visual Studio 6.0 Enterprise Edition - SP3

[Sam Finch]

I havn't tested this yet, but I'm posting the code just in case it blows my computer up killing me in the process.

(actually that's unlikley, but it might cause a GPF and crash VB loosing any changes)

Hopefully you can at least cet the gist of what's going on, what I'm doing is using GetDIBits to get a scanline off the screen and putting it into a string and using GetBitmapBits to put the top line of your bitmap into a string. then I'm using InStr to see if there's a match between these 2 strings, if there is we copy that part of the screen into a bitmap and compare this with the test bitmap, if this matches we return the position of the centre of the bitmap, if it doesn't we check the rest of the scanline until no more matches our found, then we ove onto the second scanline and so on down the screen.

you never know, it might work :)


On Error Goto NextPost:
Err.Raise 500,"This code raised a GPF, the code below doesn't"


[Edited by Sam Finch on 08-21-2000 at 08:58 PM]

[Sam Finch]

As I suspected, Big Fat GPF, i'll try see what's happening and post up a revision.


S'OK, fixed the GPF(I left out a ByVal, but that's better now)

But it doesn't work (however, it took less than a second not to work, rather than 3 hours)

[Edited by Sam Finch on 08-21-2000 at 06:35 PM]

[Sam Finch]

ok, it's still not working, this is the code in it's current form

Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type

Private Type BITMAPINFO
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
Colours(0 To 3) As Long
End Type


Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long



Private Function CheckScreen(hBmp As Long, Width As Long, Height As Long, Output As POINTAPI) As Boolean
Dim hScreenBitmap As Long
Dim hdc As Long 'Used as a general device context
Dim hdc2 As Long
Dim hDCBmp As Long 'the bitmap inside it
Dim strScreenLine As String 'represents the bits in a scanline of the screen as a string
Dim strBitmapLine As String 'Represents the bits in a scanline of the bitmap as a string
Dim BmpInfo As BITMAPINFO 'used in GetDIBits
Dim i As Integer
Dim j As Integer

'Fill First string
BmpInfo.biSize = LenB(BmpInfo)
Call GetDIBits(GetDC(GetDesktopWindow), hBmp, 0, 0, ByVal 0, BmpInfo, 1)

strBitmapLine = Space(Width * 2)
Call GetDIBits(GetDC(GetDesktopWindow), hBmp, 0, 1, ByVal StrPtr(strBitmapLine), BmpInfo, 1)


'Create a new Device Context and Bitblt the Screen to it
hdc = CreateCompatibleDC(GetDC(GetDesktopWindow))
DeleteObject SelectObject(hdc, CreateCompatibleBitmap(GetDC(GetDesktopWindow), ScaleX(Screen.Width, vbTwips, vbPixels), ScaleY(Screen.Height, vbTwips, vbPixels)))

Call BitBlt(hdc, 0, 0, ScaleX(Screen.Width, vbTwips, vbPixels), ScaleY(Screen.Height, vbTwips, vbPixels), GetDC(GetDesktopWindow), 0, 0, vbSrcCopy)

'Get the screen bitmap out of there and put a picturesized one in
hDCBmp = CreateCompatibleBitmap(hdc, Width, Height)
hScreenBitmap = SelectObject(hdc, hDCBmp)

'Make a second dc to hold the new screen
CreateCompatibleDC (hdc)


'Get bitmap info for screen bitmap
BmpInfo.biSize = LenB(BmpInfo)
MsgBox GetDIBits(GetDC(GetDesktopWindow), hScreenBitmap, 0, 0, ByVal 0, BmpInfo, 1)


'loop through all the scamlines on the screen
For i = 0 To ScaleY(Screen.Height, vbTwips, vbPixels) - (1 + Height)

'put the data from one scanline into a string
strScreenLine = Space(ScaleX(Screen.Width, vbTwips, vbPixels) * 2)

'*************************************************
'* This is the line that isnt working *
'*No matter what the value of i is the string is *
'* always filled with the same data *
'* Can Someone Fix this *
'*************************************************
Call GetDIBits(GetDC(GetDesktopWindow), hScreenBitmap, i, 1, ByVal StrPtr(strScreenLine), BmpInfo, 1)

j = 1
Do
'check for a match
j = InStr(j, strScreenLine, strBitmapLine)

If j Then

If (j Mod 2 = 1) Then 'We've found a match for the first line

'put the screen bitmap into a dc so it can be copied
DeleteObject SelectObject(hdc2, hScreenBitmap)

'bitblt the right part of the screen onto the Memory DC
Call BitBlt(hdc, 0, 0, Width, Height, hdc2, Fix(j / 2), i, vbSrcCopy)

'get the screen bitmap out again so we can use GetDIBits
Call SelectObject(hdc2, CreateCompatibleBitmap(hdc2, 1, 1))

'check for rest of match
If CheckMatch(hDCBmp, hBmp, Width, Height) Then

'Hooray
Output.x = Fix((j + Width) / 2)
Output.y = Fix(i + (Height / 2))

'close bitmaps and dcs down
DeleteObject hScreenBitmap
DeleteDC hdc
DeleteDC hdc2

'return true
CheckScreen = True
Exit Function

End If


End If

j = j + 1
Else

Exit Do

End If
Loop

Next i

'no matches

'close down objects
DeleteObject hScreenBitmap
DeleteDC hdc
DeleteDC hdc2

'return false
CheckScreen = False
End Function








'This takes 2 bitmaps of the same size andchecks to see if they are the same
'It is very slow sow we do it as little as often
Private Function CheckMatch(ByVal Bmp1 As Long, ByVal Bmp2 As Long, ByVal Width As Long, ByVal Height As Long) As Boolean
Dim lngBitmap1() As Long
Dim lngBitmap2() As Long
Dim i As Long

Dim lngBitmapSize As Long
lngBitmapSize = Width * Height 'this is how many longs we need to contain our bitmaps

'Make our arrays big enough to hold the bitmaps
ReDim lngBitmap1(1 To lngBitmapSize)
ReDim lngBitmap2(1 To lngBitmapSize)

'put the bitmaps into the arrays
Call GetBitmapBits(Bmp1, lngBitmapSize * 4, lngBitmap1(1))
Call GetBitmapBits(Bmp1, lngBitmapSize * 4, lngBitmap2(1))


'loop through the bitmap and check for mismatches
For i = 1 To lngBitmapSize

If Not (lngBitmap1(i) = lngBitmap2(i)) Then 'If one of the pixels is wrong

CheckMatch = False
Exit Function

End If

DoEvents 'Let the app handle clicks etc

Next i

'If we get to here we've found a match

CheckMatch = True

End Function









Private Sub Command1_Click()
Dim BmpCentre As POINTAPI 'Center of the bitmap

If CheckScreen(Picture1.Picture.Handle, ScaleX(Picture1.Picture.Width, vbTwips, vbPixels), ScaleY(Picture1.Picture.Height, vbTwips, vbPixels), BmpCentre) Then

MsgBox "It's at " & BmpCentre.x & ", " & BmpCentre.y

Else

MsgBox "It's not there"

End If
End Sub




It seems to be working exept that getDIBits always returns the same scanline (the top one i'd imagine) no matter what value i is

If anyone uses GetDIBits regularaly thn could you give us a hand.

[Edited by Sam Finch on 08-21-2000 at 09:02 PM]

[vbzero]

OK - There's still a problem left:

The program works and responds at any time but it
doesn't find the picture on the screen.
I captured a part of the desktop before and tried
to find it. Then a message results 1 and says that
the picture can't be found.

Any suggestions?

thx, sub-zero


Visual Studio 6.0 Enterprise Edition - SP3

[Sam Finch]

Yeah, sorry about that, basicly there are 2 ways of getting the data out of a bitmap em masse rather than pixel by pixel

the first one is a very simple one called Get Bitmap Bits, this I understand and can do. The other is GetDIBits, this is slightly more powerful but It's harder to use, and today was the first time I've ever ued it.


Basicly the way it works is it examines one horizontal line across the screen at a time, to do this I need to use GetDIBits, unfortunatley it's not working too well and no matter what line I ask it for it always gives me the same line. so it's not checking the whole screen but just the first line 400 times.

I'm gonna go back and edit the 2 posts with blocks of code, get rid of all the code in the first block and put a big flag in the second showing where this is happening.

Then hopefully someone with more experience with GetDIBits can correct it.