|
楼主 |
发表于 2008-11-5 23:59
|
显示全部楼层
偶刚刚弄了个抓图的
http://club.excelhome.net/thread-366963-1-1.html
这是源码,(胡乱纠集在一起的,肯定不好)
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 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
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 GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Me.Visible = False
Call Sleep(10)
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
Bhandle = CreateCompatibleBitmap(SourceDC, GetSystemMetrics(0), GetSystemMetrics(1))
SelectObject DestDC, Bhandle
BitBlt DestDC, 0, 0, GetSystemMetrics(0), GetSystemMetrics(1), SourceDC, 0, 0, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, Bhandle
CloseClipboard
DeleteDC DestDC
ReleaseDC Dhandle, SourceDC
Me.Picture = Clipboard.GetData()
Me.Visible = True
End Sub
Private Sub Command2_Click()
Me.Picture = Me.Image
CommonDialog1.Filter = "BMP文件(*.bmp)|*.bmp|JPG文件(*.jpg)|*.jpg"
CommonDialog1.ShowSave
CommonDialog1.Flags = &H2 + &H4 + &H8
If CommonDialog1.FileName <> "" Then
SavePicture Me.Picture, CommonDialog1.FileName
End If
End Sub
Private Sub Command3_Click()
End
End Sub
偶是一点一点堆积出来的
例如:先开始的取屏幕的多少是给定的数据,偶就把八版发的取全屏的api函数用上
取全屏后后发现抓取的图像中有窗体本身,偶就设置Me.Visible,设置后还是不行,本来打算放弃的,但又猜想设置一下时间或许有用,就又把隔多少时间执行的API函数加上,一试才发现可以了
就是这么堆出来的
[ 本帖最后由 HHAAMM 于 2008-11-6 00:02 编辑 ] |
|