scrncap.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9705
   LinkTopic       =   "Form1"
   ScaleHeight     =   7650
   ScaleWidth      =   9705
   StartUpPosition =   3  'Windows Default
   Begin VB.Label Label1 
      Caption         =   "单击窗体，捕获640×480大小的屏幕"
      Height          =   375
      Left            =   2880
      TabIndex        =   0
      Top             =   3480
      Width           =   3015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

'捕捉屏幕图象函数
'Left为捕捉屏幕区域的左端
'Top为捕捉屏幕区域的上端
'Right为捕捉屏幕区域的右端
'Bottom为捕捉屏幕区域的下端
Private Sub ScrnCap(Left As Long, Top As Long, Right As Long, Bottom As Long)
    Dim rWidth As Long
    Dim rHeight As Long
    Dim SourceDC As Long
    Dim DestDC As Long
    Dim BHandle As Long
    Dim Wnd As Long
    Dim DHandle As Long
    rWidth = Right - Left
    rHeight = Bottom - 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, Left, Top, &HCC0020
    Wnd = Screen.ActiveForm.hwnd
    OpenClipboard Wnd
    EmptyClipboard
    SetClipboardData 2, BHandle
    CloseClipboard
    DeleteDC DestDC
    ReleaseDC DHandle, SourceDC
End Sub

Private Sub Form_Click()
    ScrnCap 0, 0, 640, 480
    Me.Picture = Clipboard.GetData
End Sub