VB_屏幕捕获

fieldmax

1. 
   
2. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
   
3. Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
   
4. Private Declare Function EmptyClipboard Lib "user32" () As Long
   
5. Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
   
6. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
   
7. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
   
8. 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
   
9. 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
   
10. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    
11. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    
12. Private Declare Function CloseClipboard Lib "user32" () As Long
    
13. Dim p1 As String
    
14. Sub ScrnCap(Lt, Top, Rt, Bot)
    
15. rWidth = Rt - Lt
    
16. rHeight = Bot - Top
    
17. SourceDC = CreateDC("DISPLAY", 0, 0, 0)
    
18. DestDC = CreateCompatibleDC(SourceDC)
    
19. BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
    
20. SelectObject DestDC, BHandle
    
21. BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
    
22. Wnd = Screen.ActiveForm.hwnd
    
23. OpenClipboard Wnd
    
24. EmptyClipboard
    
25. SetClipboardData 2, BHandle
    
26. CloseClipboard
    
27. DeleteDC DestDC
    
28. ReleaseDC DHandle, SourceDC
    
29. End Sub
    
30. '以下的示例把屏幕图象捕捉后，放到Picture1 中。
    
31. Sub Command1_Click()
    
32. ScrnCap 400, 300, 500, 400
    
33. Picture1.Picture = Clipboard.GetData()
    
34. End Sub
    
35. Private Sub Command2_Click()
    
36. ScrnCap 400, 300, 500, 400
    
37. Picture2.Picture = Clipboard.GetData()
    
38. For i = 1 To Picture1.Width Step 15
    
39.     For j = 1 To Picture1.Height Step 15
    
40.         If Picture1.Point(i, j) <> Picture2.Point(i, j) Then
    
41.             MsgBox "图像改变"
    
42.             Exit Sub
    
43.         End If
    
44.     Next j
    
45. Next i
    
46. End Sub
    

复制代码