杨运峰 杨淼

    屏幕抓图软件HyperSnap-DX很多人都使用过，它强大的屏幕抓图功能，使我们在多媒体制作中爱不释手。笔者根据自己在课件制作中的需要，用Visual Basic制作了一个屏幕捕捉程序，它保持了HyperSnap-DX的基本功能，又根据自己的要求增加了一些新的功能，使用起来非常方便，在这里希望与各位VB爱好者进行交流。                 
    为了适应多媒体课件的制作的要求，主窗体主要设计了编辑、图象、捕捉和工具菜单。编辑菜单中有复制、粘贴、剪贴、清除四个菜单项；图象菜单中有左右翻转、上下翻转、放大和缩小四个菜单项；捕捉中有矩形、全屏、活动窗体、工作区和摄象头捕捉五个菜单项；工具中有图片格式转换（包括转JPG和GIF两种格式）、浏览器二个菜单项。下面主要介绍这些功能的设计和实现。
    1.主窗体的图片框
主窗体上有PicScroll和PicBmp两个图片框，其中PicBmp包含在容器PicScroll中。为了看到比PicScroll还大的图片，捕捉到的图片被装载到PicBmp中，但只能看到与PicScroll大小一样PicBmp中的图片，当滚动滚动条时，重新定位PicBmp在PicScroll中的位置，就可以看到PicBmp中的全部图片。
    2.复制与粘贴
通过系统对象Clipboard.的SetData的方法，可以把图片放入粘贴板中，再用GetData方法可以获得粘贴板中的图片。
Clipboard.SetData PicBmp.Image
PicBmp.Picture = Clipboard.GetData
    3．矩形捕捉
    先隐藏主窗体，延时一秒钟后，将新建窗体Frorm1显示出来，并让Form1上的时钟控件有效，其目的是让时钟控制放大镜的位置，然后调用函数GetScreenSnapshot将捕捉到的整个桌面放到窗体Form1上，Form1的WindowState 属性一定要设置为2，这样可以让Form1铺满整个屏幕，以保证Form1能接收到鼠标事件。
frmmain.Visible = False
 Call timesub(1) ‘延时
Form1.Visible = True
 Form1.Timer1.Enabled = Tru
   start1 = True ‘开始画大十字
 Form1.Picture = GetScreenSnapshot(0)
    GetScreenSnapshot函数的作用是捕获整个桌面，它不仅在矩形捕获中要使用，而且在全屏捕获中也要调用。核心代码如下：
GetWindowRect hwnd, rcWindow’获得整个窗口的范围矩形
targetDC = GetWindowDC(hwnd) ‘获取整个窗口的设备场景
hDc = CreateCompatibleDC(targetDC) ‘创建一个内存设备场景
tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight) ‘创建位图
oldPict = SelectObject(hDc, tempPict) ‘选择位图放到内存设备场景中
BitBlt hDc, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy ‘复制位图
tempPict = SelectObject(hDc, oldPict)
    在Form1上用时钟控件Timer1显示和控制放大镜的位置。放大镜用DoZoom过程来实现，先用API函数GetCursorPos，取得鼠标当前的位置坐标，计算出当前鼠标位置为中心的一个矩形范围，然后用函数 StretchBlt 放大这个矩形。
在Form1的MouseMove事件中，用Line函数来绘制大十字和抓取矩形方块。Form1的DrawStyle的属性一定要设置为6，这样在同样的位置画同一条线时，可以达到擦去的效果。
    先画抓取矩形方块，并记下方块的坐标，当鼠标移动到新位置时，擦去原来的方块后，在新位置重画方块，第一次画方块，只画不檫，最后一次画方块只檫不画。画大十字与画抓取方块方法一样。
    在Form1的MouseDown事件中，先判定是第一次还是第二次按下的鼠标左键，如果是第一次按下的左键，可得到抓取矩形的第一个顶点坐标，如果是第二次按下的鼠标左键，可得到第二个顶点坐标，如果按下的其它键，本次捕获取消。有了矩形的两个顶点坐标，可以计算出抓取的矩形区域，再用PaintPiicture方法，把捕捉到的图片画到主窗体中的Picbmp中。捕捉图片的核心代码如下：
 frmmain.Picbmp.Width = xwidth * Screen.TwipsPerPixelX ‘坐标转换
 frmmain.Picbmp.Height = yheight * Screen.TwipsPerPixelY
frmmain.Picbmp.Picture = LoadPicture("")’清空图片框
‘把图片装入frmmain.Picbmp
frmmain.Picbmp.PaintPicture Form1.Picture, 0, 0, , , startx * Screen.TwipsPerPixelX, starty * Screen.TwipsPerPixelY, xwidth * Screen.TwipsPerPixelX, yheight * Screen.TwipsPerPixelY
放大镜功能的核心代码如下：
    hWndDesk = GetDesktopWindow()’获得桌面DC
hDCDesk = GetDC(hWndDesk)
 With sizDest’目标矩形
 .Left = 0
 .Top = 0
 .Width = frmzoom.Piczoom.ScaleWidth
 .Height = frmzoom.Piczoom.ScaleHeight
End With
With sizSrce’源矩形
 .Left = ptMouse.x - Int((sizDest.Width / 2) / mfscale)
 .Top = ptMouse.y - Int((sizDest.Height / 2) / mfscale)
 .Width = Int(sizDest.Width / mfscale)
 .Height = Int(sizDest.Height / mfscale)
 lTemp = Int(.Width * mfscale) ‘调整宽度与高度
If lTemp > sizDest.Width Then
   sizDest.Width = lTemp
ElseIf lTemp < sizDest.Width Then
   .Width = .Width + 1
   sizDest.Width = lTemp + mfscale
End If
lTemp = Int(.Height * mfscale)
If lTemp > sizDest.Height Then
 sizDest.Height = lTemp
ElseIf lTemp < sizDest.Height Then
 .Height = .Height + 1
  sizDest.Height = lTemp + mfscale
End If
End With
 frmzoom.Piczoom.Cls
‘复制位图
lRet = StretchBlt(frmzoom.Piczoom.hDc, sizDest.Left, sizDest.Top, sizDest.Width, sizDest.Height, hDCDesk, sizSrce.Left + 507, sizSrce.Top + 485, sizSrce.Width, sizSrce.Height, SRCCOPY)
lRet = ReleaseDC(hWndDesk, hDCDesk)’ 释放桌面DC

    4．摄像头捕捉
    在摄像头捕捉中，使用了控件evVidCap，ShowDlgVideoSource方法可以获得视频源，ShowDlgVideoFormat方法获得视频格式， SaveDIB方法保存图片。摄象头捕捉的核心代码如下：
Select Case Index
  Case 3
   If NewFileName <> "" And Right(NewFileName, 3) = "bmp" Then
     Kill NewFileName’删除临时文件
frmmain.Picbmp.Picture = FrmVid.Pic1.Picture’ 加载图片
frmmain.Picbmp2.Picture = frmmain.Picbmp.Picture
    frmmain.Picbmp.Picture = frmmain.Picbmp.Image
Call MnuEnablSub(True)’调整文件和编辑菜单
End If
Unload Me
  Case 0
     EzVid.ShowDlgVideoSource’视频源
  Case 1
     EzVid.ShowDlgVideoFormat’ 视频格式
  Case 2
     If Right(App.Path, 1) = "\" Then’加载图片
        NewFileName = App.Path & "$$temmmmmm.bmp"‘临时文件
        EzVid.SaveDIB (NewFileName)’保存图片
        Pic1.Picture = LoadPicture(NewFileName)’ 加载图片
     Else
        NewFileName = App.Path & "\$$temmmmmm.bmp"
        EzVid.SaveDIB (NewFileName)
        Pic1.Picture = LoadPicture(NewFileName)
     End If
End Select