VB怎么做个截图工具

1 启动新 VisualBasic 常用 Exe 项目。 默认情况下创建 Form 1。
2 在 项目 菜单上, 选择将一个新模块添加到现有项目 添加模块 。
3 向窗体, 名称之一添加两 框 Pic_Edit （目标）, 和其他名称 Pic_Dest （目标）。
4 将是 Pic_Edit Picture 属性设置为要从中选择区域位图
5 将是 Pic_Dest AutoRedraw 属性设置为 True
6 以下代码添加到 Module 1：Public Const INVERSE = 6
Public Const DOT = 2
Public Const SOLID = 0
Public OrigX As Long
Public OrigY As Long
Public DestX As Long
Public DestY As Long
Public Sub Draw_Selection_Rectangle()
' Set drawing mode to INVERSE since this routine also used to erase
' the selection rectangle by simply drawing over the currently
' displayed rectangle

With EditorPic_Edit
DrawMode = INVERSE
DrawStyle = DOT
EditorPic_EditLine (OrigX, OrigY)-(DestX, DestY), , B
DrawStyle = SOLID
End With
End Sub
Public Sub Copy_Rectangle()
With EditorPic_Dest
Cls
Visible = True
Height = DestY - OrigY
Width = DestX - OrigX
PaintPicture EditorPic_Edit, 0, 0, (DestX - OrigX), _
(DestY - OrigY), OrigX, OrigY, (DestX - OrigX), _
(DestY - OrigY), vbSrcCopy
End With

' Make sure the clipboard is clear, then copy the image:
ClipboardClear
ClipboardSetData EditorPic_DestImage
End Sub
7 以下代码添加到 Form 1：Private Sub Pic_Edit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Pic_EditRefresh
Pic_DestVisible = False
OrigX = X
OrigY = Y
DestX = OrigX
DestY = OrigY
Call Module1Draw_Selection_Rectangle
End Sub
Private Sub Pic_Edit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
DestX = X
DestY = Y
Pic_EditRefresh
Call Module1Draw_Selection_Rectangle
End If
End Sub
Private Sub Pic_Edit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Check to see if mouse moved or goes the "wrong" way:
If DestX <= OrigX Or DestY <= OrigY Then
Pic_EditRefresh
Exit Sub
End If

If Button = 1 Then Call Copy_Rectangle
End Sub
8 启动应用程序并选择用鼠标与位图的区域。 当您松开鼠标按钮, Pic_Dest 出现 备注 所选区域： 如果备份 MS 画图、 MSWord 或任何其他应用程序可能需要粘贴位图, 打开您就可以粘贴到该应用程序图像的选定部分。 也可以通过剪贴板查看程序查看剪贴板的内容。

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
Private Sub Command1_Click()
Call ScrnCap(0, 0, 800, 600) '调用函数，4个参数为左上，右下坐标
Image1Picture = ClipboardGetData()
End Sub
Sub ScrnCap(Lt As Integer, top As Integer, Rt As Integer, Bot As Integer) '屏幕截图核心函数
Dim rWidth, rHeight, SourceDC, DestDC, BHandle, Wnd, DHandle
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 = ScreenActiveFormhwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub

---