VB Snippet - Screen Capture

VB Code:

Public Function GetScreenCapture( _
   Optional ByVal FullScreen As Boolean = False) As Image
 
   ' Captures the current screen and returns as an Image
   ' object
 
   Dim objSK As SendKeys
 
   Dim imgCapture As Image
 
   If FullScreen = True Then
 
       ' Print Screen pressed twice here as some systems
 
       ' grab active window "accidentally" on first run
 
       objSK.SendWait("{PRTSC 2}")
 
   Else
 
       objSK.SendWait("%{PRTSC}")
 
   End If
 
   Dim objData As IDataObject = Clipboard.GetDataObject()
 
   Return objData.GetData(DataFormats.Bitmap)
 
End Function

That's crap. You should copy the screen using BitBlt or something:

VB Code:

'Declares
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) 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 CreateCompatibleDC Lib "gdi32" (ByVal iDC As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal iDC As Long, _
        ByVal iWidth As Long, ByVal iHeight As Long) As Long
    
    Private Declare Function SelectObject Lib "gdi32" (ByVal iDC As Long, ByVal iObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal iObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal iDC As Long) As Long
 
Private Sub CaptureScreen()
    Dim w As Long
    Dim h As Long
    
    Dim DC As Long
    Dim CompatibleBitmap As Long
    Dim OriginalObject As Long
    
    'Get screen size
    w = CLng(Screen.Width / Screen.TwipsPerPixelX)
    h = CLng(Screen.Height / Screen.TwipsPerPixelY)
    
    'Create buffer
    DC = CreateCompatibleDC(Me.hDC)
    CompatibleBitmap = CreateCompatibleBitmap(Me.hDC, w, h)
    OriginalObject = SelectObject(DC, CompatibleBitmap)
    
    'Capture fullscreen
    BitBlt DC, 0, 0, w, h, GetWindowDC(GetDesktopWindow), 0, 0, vbSrcCopy
    '// Here you'd copy it to your picture box or whatever
    'BitBlt Me.hDC, 0, 0, w, h, DC, 0, 0, vbSrcCopy
    
    'Release buffer
    SelectObject DC, OriginalObject
    DeleteObject CompatibleBitmap
    DeleteDC DC
End Sub

Note that the code has been compressed to one function; of course you'd release the buffer somewhere else if you want to work with the captured picture. If you're using a picture box to capture the screen you don't need to copy it to a buffer first:

VB Code:

'Declares
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) 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 Sub CaptureScreen( iTargetDC as Long )
    Dim w As Long
    Dim h As Long
    
    'Get screen size
    w = CLng(Screen.Width / Screen.TwipsPerPixelX)
    h = CLng(Screen.Height / Screen.TwipsPerPixelY)
    
    'Capture fullscreen
    BitBlt iTargetDC, 0, 0, w, h, GetWindowDC(GetDesktopWindow), 0, 0, vbSrcCopy
End Sub
 
'Code to call:
CaptureScreen Picture1.hDC

Fox :

I always enjoy constructive critism, but, if you have a better example, kindly please post without ****ting on mine. Ther is always better ways to perform something. I guess my posting my examples, at least I give you the opportunity to post SOMETHING...:rolleyes:

Sorry for that ... seeing solutions that use printscreen just hurts my old eyes :rolleyes: That was nothing against you, just a warning for everyone trying to use the code. I tend to correct people in their ways, sorry again ;)

I knew you were messing around Fox. You are a cool guy.

Fox,

What about Dual monitors? His Example will get both screens, yours won't.

Joey

I prefer foxs code though the over one is perhaps useful if you actually want to put the screen on the clipboard. But if you just want to get a screenshot I dont think you should be changing peoples clipboards. And although you can copy it first and put it back that has bever seemed like a nice solution to me, nor has sending keys to a window unless there is no alternative.

i worship any quality code produced by James Stanich

he is the man

Quote:

---

Originally posted by Flip
i worship any quality code produced by James Stanich

he is the man

---

Am I really? :cool:

Thanks...

I tried making a program that would take a picture of the desktop and set it as the background picture of a form.
It seems that the form must be loaded and visible for you to set its background picture, and that if you set it, then increase the forms size, it only has the screenshot for the section which was its current size.

Can anyone help me with a program that will take a picture of the desktop BEFORE opening a form, and then set the form's picture to this screenshot?
I'd prefer if it didn't take a pic, save to hard drive, then open it from harddrive, though if that's the only way, I'd like if someone could do even that.
Thank you in advanced.

yitzle,

Go to the picturebox you're tring to BitBlt to and set it's properties to Autoredraw = True


Should work then

I'm not running Windows at the moment so I didn't check, but I'm drawing to the form background. If it doesn't have this property...
If it does, though, thanks for the help. I'll try it out.

i simple like foxes code because it is more powerful. I am working with a game that blocks Sendkeys or Keyb_Evnet so this is very pwoerful

Fox, how can I save the image to a file?
thanks.

i use fox's code...
When i use capture subroutine in timer control..
my mouse cursor stop when this function called by timer.
HOW CAN I STOP TO MOUSE CURSOR WHEN CAPTURING THE SCREEN??
?????

PLEASE TELL ME WHERE I M WRONG ...
---------------------------------------------

'Declares
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) 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 Sub CaptureScreen(iTargetDC As Long)
Dim w As Long
Dim h As Long
'Get screen size
w = CLng(Screen.Width / Screen.TwipsPerPixelX)
h = CLng(Screen.Height / Screen.TwipsPerPixelY)
'Capture fullscreen
BitBlt iTargetDC, 0, 0, w, h, GetWindowDC(GetDesktopWindow), 0, 0, vbSrcCopy
End Sub

Private Sub Form_Load()
CaptureScreen Me.hDC ''THIS Code WHY NOT OK
End Sub

Private Sub Timer1_Timer()
'CaptureScreen Me.hDC '''BUT THIS CODE IS OK
End Sub

If anyone is worried about replacing the clipboard contents you could just use something as simple as this:

Code:

---

'Have a hidden textbox somewhere on ur form and call it TB1

TB1.Paste()
GetScreenCapture()
TB1.Copy()

---

Here is the simpler code:

Code:

---

Dim bounds As Rectangle
        Dim screenshot As System.Drawing.Bitmap
        Dim graph As Graphics
        bounds = Screen.PrimaryScreen.Bounds
        screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        graph = Graphics.FromImage(screenshot)
        graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
        PictureBox1.Image = screenshot

---

Source:
http://www.youtube.com/watch?v=iFkYuOuDU9c