用VB抓图

Question

1 将PictureBox的AutoRedraw设定为True
2 利用Bitblt函数将屏幕上任意位置的图像Copy到PictureBox上
3 SavePicture 你的文件名, PictureBox.Image

Answer 1

'回复人：TechnoFantasy(www.applevb.com)　(2001-6-16 21:37:00)  得0分
'to kimryo(kimryo)
'谁说VB数据类型单一，很不好用呢。截屏VB十分简单，看看下面的代码：
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 GetDC Lib "user32" (ByVal hwnd As Long) As LongConst SRCCOPY = &HCC0020Private Sub Form_Activate()
    Me.Hide
    For i = 1 To 10000  '延时
        DoEvents
    Next i
    BitBlt Picture1.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY
    SavePicture Picture1.Image, "sss.bmp"
    End
End SubPrivate Sub Form_Load()
    With Picture1
        .AutoRedraw = True
        .Width = Screen.Width
        .Height = Screen.Height
    End With
End Sub'Private Sub Form_Activate()
'    Me.Hide
'    BitBlt Picture1.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY
'    SavePicture Picture1.Image, "c:\sss.bmp"
'End Sub'Private Sub Form_Load()
'    With Picture1
'        .AutoRedraw = True
'        .Width = Screen.Width
'        .Height = Screen.Height
'    End With
'End Sub'一分钟搞定，不懂不要乱讲，工具好不好在于用的人。
'　回复人：TechnoFantasy(www.applevb.com)　(2001-6-16 21:39:00)  得0分
'sorry,多写了代码，下面的Activate以及Load没有用'或把下面的保存为 aa.frmVERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6495
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8235
   LinkTopic       =   "Form1"
   ScaleHeight     =   6495
   ScaleWidth      =   8235
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1 
      Height          =   5085
      Left            =   240
      ScaleHeight     =   5025
      ScaleWidth      =   7950
      TabIndex        =   1
      Top             =   735
      Width           =   8010
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   4965
      TabIndex        =   0
      Top             =   30
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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