Capture to Clipboard
This module will allow you to capture the entire screen or just one form, and copy the image to the Windows clipboard.
Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const SRCCOPY = &HCC0020 ' (DWORD) destination = source
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
'API
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
'if you have problems with this function add the Alias "SetClipboardDataA"
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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 CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
'Screen Capture Procedure, coordinates are expressed in pixels
Public Sub CaptureScreen(Left As Long, Top As Long, Width As Long, Height As Long)
Dim srcDC As Long
Dim trgDC As Long
Dim BMPHandle As Long
Dim dm As DEVMODE
srcDC = CreateDC("DISPLAY", "", "", dm)
trgDC = CreateCompatibleDC(srcDC)
BMPHandle = CreateCompatibleBitmap(srcDC, Width, Height)
SelectObject trgDC, BMPHandle
BitBlt trgDC, 0, 0, Width, Height, srcDC, Left, Top, SRCCOPY
OpenClipboard Screen.ActiveForm.hWnd
EmptyClipboard
SetClipboardData 2, BMPHandle
CloseClipboard
DeleteDC trgDC
ReleaseDC BMPHandle, srcDC
End Sub
'Usage: how to capture the entire screen
Private Sub Command1_Click()
Form1.Visible = False
CaptureScreen 0, 0, 800, 600
Form1.Visible = True
Picture1 = Clipboard.GetData()
End Sub
Usage: how to capture a form
Private Sub Command2_Click()
CaptureScreen Form1.Left \ Screen.TwipsPerPixelX, Form1.Top \ Screen.TwipsPerPixelY, Form1.Width \ Screen.TwipsPerPixelX, Form1.Height \ Screen.TwipsPerPixelY
Picture1 = Clipboard.GetData()
End Sub
Special Instructions
This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.