[VBnet Bitmaps] BitBlt: Mimicking PrintScreen to Create a 'PrintForm'


	Visual Basic Bitmap Routines BitBlt: Mimicking PrintScreen to Create a 'PrintForm'

Posted:	Thursday December 26, 1996
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6, and VB3, VB4-16 with appropriate declarations
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	BitBlt: Mimicking the PrintScreen Function BitBlt: Mimicking PrintScreen to Create a 'PrintForm' CreateEnhMetaFile: Saving a PrintScreen as a Windows Enhanced Metafile InflateRect: Highlighting External Windows keybd_event: Calling Windows' PrintScreen Function OleCreatePictureIndirect: Mimicking PrintScreen Using OLE

Prerequisites

Code from the article BitBlt: Mimicking the PrintScreen Function.

If you look closely at the value of hWndDesk set in the BitBlt: Mimicking the PrintScreen Function routine, you will see that the demo passes the handle to the desktop window. Since all windows live on the desktop, this enables the PrintScreen routine to capture the desktop to the picture.

If you were to modify handle passed to that of the current form and change coordinates of the form size you would essentially then have a 'PrintForm' routine. This demo therefore utilizes the project developed in BitBlt: Mimicking the PrintScreen Function and adds an additional routine.

BAS Module Code

None.

Form Code

To the form, add the following code:

Option Explicit

Private Sub Command2_Click()

  PrintForm

End Sub


Private Sub PrintForm()

   Dim hWndForm As Long
   Dim hDCForm As Long
   Dim LeftForm As Long
   Dim TopForm As Long
   Dim WidthForm As Long
   Dim HeightForm As Long
  
  'define the screen coordinates (upper 
  'corner (0,0) and lower corner (Width, Height)
   LeftForm = 0
   TopForm = 0
   WidthForm = Me.ScaleX(Me.Width, vbTwips, vbPixels)
   HeightForm = Me.ScaleY(Me.Height, vbTwips, vbPixels)
    
  'copy the form to the picture box
   Call BitBlt(Picture1.hdc, 0, 0, WidthForm, HeightForm, _
               Me.hDc, LeftForm, TopForm, vbSrcCopy)

End Sub

Variation

By providing a means for delaying execution of the routine (allowing the user time to select another open window) another slight modification gives you a method to capture the active window instead:

Private Sub PrintAnyWindow()

   MsgBox "Two seconds after you press _
           OK to close this dialog, the currently _
           active window will be copied into _
           the picture box."

   Dim delay As Date
   Dim hWndActive As Long
   Dim hDCActive As Long
   Dim LeftActive As Long
   Dim TopActive As Long
   Dim WidthActive As Long
   Dim HeightActive As Long

   Dim RectActive As RECT 
   
  'delay activation for two seconds
   delay = DateAdd("s", 2, Now)

   Do Until Now > delay
      DoEvents
   Loop
   
  'get the handle to the foreground window, its 
  'size and the display context of the window
   hWndActive = GetForegroundWindow()
   Call GetWindowRect(hWndActive, RectActive)
   hDCActive = GetWindowDC(hWndActive)
   
  'determine the coordinates of the active window
   LeftActive = 0
   TopActive = 0
   WidthActive = RectActive.Right - RectActive.Left
   HeightActive = RectActive.Bottom - RectActive.Top
   
  'Copy the active window to the picture box
   Call BitBlt(Picture1.hdc, 0, 0, WidthActive, HeightActive, _
               hDCActive, LeftActive, TopActive, vbSrcCopy)

   Call ReleaseDC(hWndActive, hDCActive)

PayPal Link