Screen Capture Class Module
Posted: 2002-06-01
By: ArchiveBot
Viewed: 61
Filed Under:
| Title | Uploaded | Size |
|---|---|---|
| Screen Cap22061722001.zip | 9/3/2020 3:45:00 PM | 1,735 |
This module will allow you to easily save screen captures. You can specify wether you want to capture the entire screen or just the active window. I've included a copy of the class module for download (since PSC doesn't do that good of a job at formating the code). Any comments or suggestions are welcome.
Original Author: unknown
Code
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As
Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias
"MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Function GetVersionEx& Lib "kernel32" Alias
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO)
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2
' used for dwPlatformId
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO ' 148 Bytes
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Function SaveScreenToFile(ByVal strFile As String, Optional EntireScreen As Boolean
= True) As Boolean
Dim altscan%
Dim snapparam%
Dim ret&, IsWin95 As Boolean
Dim verInfo As OSVERSIONINFO
On Error GoTo errHand
'Check if the File Exist
If Dir(strFile) <> "" Then
Kill strFile
'Exit Function
End If
altscan% = MapVirtualKey(VK_MENU, 0)
If EntireScreen = False Then
keybd_event VK_MENU, altscan, 0, 0
' It seems necessary to let this key get processed before
' taking the snapshot.
End If
verInfo.dwOSVersionInfoSize = 148
ret = GetVersionEx(verInfo)
If verInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
IsWin95 = True
Else
IsWin95 = False
End If
If EntireScreen = True And IsWin95 Then snapparam = 1
DoEvents ' These seem necessary to make it reliable
' Take the snapshot
keybd_event VK_SNAPSHOT, snapparam, 0, 0
DoEvents
If EntireScreen = False Then keybd_event VK_MENU, altscan, KEYEVENTF_KEYUP, 0
SavePicture Clipboard.GetData(vbCFBitmap), strFile
SaveScreenToFile = True
Exit Function
errHand:
'Error handling
SaveScreenToFile = False
End Function
Comments on this post
No comments have been added for this post.
You must be logged in to make a comment.