原帖及讨论：http://bbs.bccn.net/thread-81763-1-1.html

'======================================================================================
'=                                   邮箱：freeforever@sohu.com                       =
'=                                             useforprogram@126.com                  =
'=       此程序是为我的手机而写，用来在屏幕上抓图（128X128，我手机图片的大小）        =
'=                                                                        2005-8-5    =
'======================================================================================
'2005-07-21更新:与AcdSee3.1配合使用抓图时使其变慢，原因是取得设备的DC后没有释放
Option Explicit
'坐标类
Private Type POINTAPI
    X As Long
    Y As Long
End Type
'Image的拷贝常量,用在Bitblt函数中
Private Const SRCCOPY = &HCC0020
'CombineRgn函数执行XOR操作的常数
Private Const RGN_XOR = 3
'文件的序号(全局变量)
Dim intF_Num As Integer
'移动窗体时记录下鼠标坐标(全局变量)
Dim xx As Single, yy As Single
'标识窗体是否可以移动(全局变量)
Dim blnMove As Boolean
'获取指定窗口的设备场景,HWnd为0时即屏幕的DC,
'在下面Bitblt函数中到用到屏幕的DC
Private Declare Function GetDC Lib "user32" ( _
    ByVal hwnd As Long) As Long
'保存图片用到的关键函数,第一个参数用Picture Box的句柄,
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
'创建一个由点X1，Y1和X2，Y2描述的矩形区域
Private Declare Function CreateRectRgn Lib "gdi32" ( _
    ByVal X1 As Long, _
    ByVal Y1 As Long, _
    ByVal X2 As Long, _
    ByVal Y2 As Long) As Long
'将两个区域组合为一个新区域
Private Declare Function CombineRgn Lib "gdi32" ( _
    ByVal hDestRgn As Long, _
    ByVal hSrcRgn1 As Long, _
    ByVal hSrcRgn2 As Long, _
    ByVal nCombineMode As Long) As Long
'改变窗口的区域,中空的窗口就是用这个函数和上面两个函数组合生成的
Private Declare Function SetWindowRgn Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hRgn As Long, _
    ByVal bRedraw As Long) As Long
'将用区坐标转换成屏幕坐标,用它来知道中空框的具体位置
Private Declare Function ClientToScreen Lib "user32" ( _
    ByVal hwnd As Long, _
    lpPoint As POINTAPI) As Long
'释放由调用GetDC或GetWindowDC函数获取的指定设备场景无效
'它对类或私有设备场景无效（但这样的调用不会造成损害）
'对那些用CreateDC一类的DC创建函数生成的设备场景，不要用本函数
Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
'取回与某一设备场景相关的窗口的句柄
Private Declare Function WindowFromDC Lib "user32" ( _
    ByVal hdc As Long) As Long
'抓取图片
Private Sub Command1_Click()
    Dim pos As POINTAPI
    '下面两个值选取的是中空框在窗口的起始坐标
    pos.X = 11: pos.Y = 12
    '把刚选取的坐标转换成屏幕坐标,hwnd是Form1的句柄
    ClientToScreen hwnd, pos
    Dim lngDC As Long
    '得到桌面的DC,用完后要释放
    lngDC = GetDC(0)
    '把"看到的"图片存在Picture1中
    BitBlt Picture1.hdc, 0, 0, 128, 128, _
            lngDC, pos.X, pos.Y, SRCCOPY
    '更新Picture1,显示存进来的图片
    Picture1.Refresh
    '文件路径和文件名变量
    Dim f_Path As String, f_name As String
    '选当前路径为图片保存位置
    f_Path = App.Path
    If Right(f_Path, 1) <> "\" Then
        f_Path = f_Path + "\"
    End If
    '记录文件编号
    intF_Num = intF_Num + 1
    '得到文件名
    f_name = "pt" + Format(intF_Num, "000") + ".bmp"
    '保存图片
    SavePicture Picture1.Image, f_Path + f_name
    ReleaseDC WindowFromDC(lngDC), lngDC '释放DC
End Sub
'改变窗口的颜色,目的是为存黑色背景的图片时看起来方便
Private Sub Command3_Click()
    If Form1.BackColor = vbBlack Then
        Frame1.BackColor = vbBlue
        Form1.BackColor = vbBlue
        Command3.BackColor = vbBlack
    Else
        Frame1.BackColor = vbBlack
        Form1.BackColor = vbBlack
        Command3.BackColor = vbBlue
    End If
End Sub
'退出程序
Private Sub Command4_Click()
    End
End Sub

Private Sub Form_Load()
    '初始化文件编号
    intF_Num = 0
    '定位窗口显示在屏幕中间
    With Me
        .Top = (Screen.Height - .Height) / 2
        .Left = (Screen.Width - .Width) / 2
    End With
End Sub
'在本程序的窗口上"挖个洞"
Private Sub Form_Resize()
'"方洞"的句柄变量
Dim lngMyWhole As Long
'得到一个"矩形"的句柄
lngMyWhole = CreateRectRgn(0, 0, 0, 0)
'注意这句比较烦琐,lngMyWhole是这句执行的结果,其后的两个函数做为参数,
'第一个函数描述的是窗口的大小
'第二个函数描述的是要保存的图片的大小,注意数值的变化,35包含了窗口的标题栏高度
'把前两个函数返回的结果做为参数进行异或得到一个新区域
CombineRgn lngMyWhole, _
           CreateRectRgn(0, 0, Me.Width, Me.Height), _
           CreateRectRgn(15, 35, 143, 163), _
           RGN_XOR
'"挖个洞",True是马上显示出来
SetWindowRgn hwnd, lngMyWhole, True
End Sub
'以下三个过程都是为了直观的移动窗口,因为Windows中移动窗口时是用虚框显示的
Private Sub Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '点下了鼠标就允许移动
    xx = X: yy = Y: blnMove = True
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If blnMove Then
        If X < xx Then '左移
            Form1.Left = Form1.Left - Int(xx - X)
        Else '右移
            Form1.Left = Form1.Left + Int(X - xx)
        End If
        If Y < yy Then '下移
            Form1.Top = Form1.Top - Int(yy - Y)
        Else '上移
            Form1.Top = Form1.Top + Int(Y - yy)
        End If
    End If
End Sub

Private Sub Frame1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '松开了鼠标就不允许移动
    blnMove = False
End Sub