[SOURCE] GetBitmap

Discussion in 'Programming General' started by Nullware, Nov 2, 2007.

[SOURCE] GetBitmap
  1. Unread #1 - Nov 2, 2007 at 3:51 PM
  2. Nullware
    Joined:
    Jan 30, 2007
    Posts:
    1,761
    Referrals:
    4
    Sythe Gold:
    0

    Nullware Guru

    [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
     
< XNA Pong | [TUT - VB6] Colorbutton: Simple User Control >

Users viewing this thread
1 guest


 
 
Adblock breaks this site