发新话题
打印

请教,如何实现对窗体及其内容进行屏幕copy图像?!

请教,如何实现对窗体及其内容进行屏幕copy图像?!

请教各位朋友,我想实现对窗体及其内容(控件)进行copy屏幕图像,不知如何处理,敬请指点!

TOP

用下面的函数抓图。  

Option  Explicit  
Private  Declare  Function  CreateDC  Lib  "gdi32.dll"  Alias  "CreateDCA"  (ByVal  lpDriverName  As  String,  ByVal  lpDeviceName  As  String,  ByVal  lpOutput  As  String,  lpInitData  As  Any)  As  Long  
Private  Declare  Function  CreateCompatibleDC  Lib  "gdi32.dll"  (ByVal  hdc  As  Long)  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  SelectObject  Lib  "gdi32.dll"  (ByVal  hdc  As  Long,  ByVal  hObject  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  OpenClipboard  Lib  "user32.dll"  (ByVal  hwnd  As  Long)  As  Long  
Private  Declare  Function  EmptyClipboard  Lib  "user32.dll"  ()  As  Long  
Private  Declare  Function  CloseClipboard  Lib  "user32.dll"  ()  As  Long  
Private  Declare  Function  SetClipboardData  Lib  "user32.dll"  (ByVal  wFormat  As  Long,  ByVal  hMem  As  Long)  As  Long  
Private  Declare  Function  DeleteDC  Lib  "gdi32.dll"  (ByVal  hdc  As  Long)  As  Long  
Private  Declare  Function  ReleaseDC  Lib  "user32.dll"  (ByVal  hwnd  As  Long,  ByVal  hdc  As  Long)  As  Long  

Private  Sub  Command1_Click()  
       ScreenCapture  0,  0,  100,  100  
       Picture1.Picture  =  Clipboard.GetData()  
End  Sub  

'  将屏幕中指定区域的图像复制到剪贴板  
'  例:  ScreenCapture  0,  0,  Screen.Width  /  15,  Screen.Height  /  15  
'          object.Picture  =  Clipboard.GetData()  
Function  ScreenCapture(ByVal  Left  As  Integer,  ByVal  Top  As  Integer,  ByVal  Right  As  Integer,  ByVal  Bottom  As  Integer)  As  Boolean  
       Dim  rWidth  As  Integer,  rHeight  As  Integer  
       Dim  SourceDC  As  Long,  DestDC  As  Long,  bHandle  As  Long,  dHandle  As  Long,  wnd  As  Long  
       rWidth  =  Right  -  Left  
       rHeight  =  Bottom  -  Top  
       SourceDC  =  CreateDC("DISPLAY",  0,  0,  0)  
       DestDC  =  CreateCompatibleDC(SourceDC)  
       bHandle  =  CreateCompatibleBitmap(SourceDC,  rWidth,  rHeight)  
       SelectObject  DestDC,  bHandle  
       BitBlt  DestDC,  0,  0,  rWidth,  rHeight,  SourceDC,  Left,  Top,  &HCC0020  
       wnd  =  Screen.ActiveForm.hwnd  
       OpenClipboard  wnd  
       EmptyClipboard  
       ScreenCapture  =  SetClipboardData(2,  bHandle)  
       CloseClipboard  
       DeleteDC  DestDC  
       ReleaseDC  dHandle,  SourceDC  
End  Function

TOP

非常感谢!

TOP

发新话题