简单的抓取屏幕生成位图文件（不用内存图象拷贝API函数）

Private Declare Function BitBlt Lib "gdi32" _

  (ByVal hDCDest As Long, ByVal XDest As Long, _

   ByVal YDest As Long, ByVal nWidth As Long, _

   ByVal nHeight As Long, ByVal hDCSrc As Long, _

   ByVal XSrc As Long, ByVal YSrc As Long, _

   ByVal dwRop As Long) As Long

Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Declare Function GetDesktopWindow Lib "USER32" () As Long

 

Private Type RECT

   Left As Long

   Top As Long

   Right As Long

   Bottom As Long

End Type

 

Private Sub CaptureScreen()

'定义变量

Dim hcScreen As Long, hwndScreen As Long

Dim SRect As RECT

Dim Width As Long, Height As Long

'先清除

Picture1.AutoRedraw = True           '这一句很重要，它用来自动重画持久图形到Picture

Picture1.Picture = LoadPicture()

'获取屏幕句柄

hwndScreen = GetDesktopWindow()

'获取屏幕大小

Call GetWindowRect(hwndScreen, SRect)

Width = SRect.Right - SRect.Left

Height = SRect.Bottom - SRect.Top

'获取屏幕设备上下文句柄

hcScreen = GetDC(hwndScreen)

'粘贴整个屏幕到Picture1中去

Call BitBlt(Picture1.hDC, 0, 0, Width, Height, hcScreen, 0, 0, vbSrcCopy)

'刷新Picture1

Picture1.Refresh

'用SavaPicture来保存图片到指定处，用Image属性（它是保存在内存中的持久图形句柄）

SavePicture Picture1.Image, "C:/My.bmp"

End Sub