截屏函数

 1 Option Explicit
 2 
 3 Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 4 Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
 5 Private Declare Function EmptyClipboard Lib "user32" () As Long
 6 Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
 7 Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 8 Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 9 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
10 Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
11 Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
12 Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
13 Private Declare Function CloseClipboard Lib "user32" () As Long
14 
15 Sub ScrnCap(Lt, Top, Rt, Bot)
16     Dim rWidth, rHeight, SourceDC, DestDC, BHandle, Wnd, DHandle
17     rWidth = Rt - Lt
18     rHeight = Bot - Top
19     SourceDC = CreateDC("DISPLAY", 0, 0, 0)
20     DestDC = CreateCompatibleDC(SourceDC)
21     BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
22     SelectObject DestDC, BHandle
23     BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
24     Wnd = Screen.ActiveForm.hwnd
25     OpenClipboard Wnd
26     EmptyClipboard
27     SetClipboardData 2, BHandle
28     CloseClipboard
29     DeleteDC DestDC
30     ReleaseDC DHandle, SourceDC
31 End Sub
32 
33 Private Sub Command1_Click()
34     Call ScrnCap(0, 0, 1024, 768)
35 End Sub
36