截屏函数

 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 

 

转载于:https://www.cnblogs.com/xxaxx/archive/2009/12/29/1635334.html