• Log in or sign up for an account here: https://www.sythe.org/login

[SOURCE] GetBitmap

Nullware

Guru
Joined
Jan 30, 2007
Sythe Gold
0
Messages
1,761
Location
/home/Canada
[SOURCE] GetBitmap
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.
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. :D
 
Runescape Gamblingrunescape gambling
Back
Top