Nullware
Guru
This is the source to get a bitmap image of the area under your mouse cursor. Have a form setup with a button called "Command1", a picture box called "Picture1". Make sure that the "Scalemode" property of your "Picture1" control is set to "Pixel"!
I did not write this from scratch so credit goes to Duke Webelos at Cruels.net for the original source. His version had some errors and was very intense on your processor thus not making it a good function to use. I've modified it to make it work perfectly and it doesn't lag at all any more.
Add a module to your project and place this code in it.
Place the following in your form's code.
Although not written by me from scratch, I modified quite a bit to get it working a lot more effectively and I've now seen that it's not too complicated at all and I surely could have made it from nothing. Enjoy.
I did not write this from scratch so credit goes to Duke Webelos at Cruels.net for the original source. His version had some errors and was very intense on your processor thus not making it a good function to use. I've modified it to make it work perfectly and it doesn't lag at all any more.
Add a module to your project and place this code in it.
Code:
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hdc As Long _
) As Long
Place the following in your form's code.
Code:
Public Function GetBitmap()
Dim DeskTopWindow As Long, DeskTopDC As Long
Dim CurPos As POINTAPI, ScreenPixel As Long
Dim i As Long, j As Long, nSize As Long, nSize2 As Long
Call GetCursorPos(CurPos)
DeskTopDC = GetDC(0)
ScreenPixel = GetPixel(DeskTopDC, CurPos.X, CurPos.Y)
Picture1.AutoRedraw = True
nSize = Picture1.ScaleWidth
nSize2 = Picture1.ScaleHeight
Picture1.Cls
For i = 0 To nSize
For j = 0 To nSize2
SetPixelV Picture1.hdc, i, j, GetPixel(DeskTopDC, CurPos.X + i, CurPos.Y + j)
Next j
Next i
ReleaseDC 0, DeskTopDC
Picture1.Refresh
End Function
Private Sub Command1_Click()
GetBitmap
End Sub
Although not written by me from scratch, I modified quite a bit to get it working a lot more effectively and I've now seen that it's not too complicated at all and I surely could have made it from nothing. Enjoy.

