14.txt

来自「介绍VB里的各种控件的使用方法,窗口控制,图像编程以及OCX等内容,还提供了一个」· 文本 代码 · 共 53 行

捕捉屏幕图象 
声明：
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, 
ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) 
As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As 
Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 
ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As 
Long
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
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
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As 
Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc 
As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
函数：
Sub ScrnCap(Lt, Top, Rt, Bot)
rWidth = Rt - Lt
rHeight = Bot - 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, Lt, Top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
以下的示例把屏幕图象捕捉后，放到Picture1 中。
Sub Command1_Click()
Form1.Visible = False
ScrnCap 0, 0, 640, 480
Form1.Visible = True
picture1 = Clipboard.GetData()
End Sub