Question

vb用shape抓图

如图：鼠标移动左图中红色框，点击按钮将红色框区域截图保存
红色框用shape做，就是截取shape框里的图片，并保存到当前文件夹的111.jpg

Answer 1

要提醒你一点，shape控件没有任何事件，所以不可能拖动它，所以不得不有所取舍。问题就是你想要的“鼠标移动左图中红色框”，这句话可能有歧义，我根据我的理解，给你两个方案，第一个方案就是使用image控件代替shape控件，这样可以实现拖动框框，但缺点是不能调整框框的颜色为红色，下面是第一个方案的代码：

窗体上的控件有
picture1（左边那个大的）
picture2（右边那个小的）
image1（就是那个框框，在添加这个控件时，要求在picture1中）
command1

需要更改的属性
image1的BorderStyle设为1
image1的Appearance设为0
picture2的AutoRedraw设为True

代码如下
Dim oldX As Single, oldY As Single

Sub CopyPicArea()
Picture2.PaintPicture Picture1, 0, 0, , , Image1.Left, Image1.Top, Image1.Width, Image1.Height
End Sub

Private Sub Command1_Click()
CopyPicArea
SavePicture Picture2.Image, App.Path & "\111.jpg"
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
oldX = X
oldY = Y
End If
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Image1.Move Image1.Left + X - oldX, Image1.Top + Y - oldX
End If
End Sub

然后是第二个方案，这个方案可以在picture1上拖动来自动调整shape控件的位置和大小，感觉比你想要的效果还好点

窗体上的控件
picture1
picture2
shape1（添加此控件时需要在picture1中）
command1

然后是代码
Sub CopyPicArea()
Picture2.Width = Shape1.Width
Picture2.Height = Shape1.Height
Picture2.PaintPicture Picture1, 0, 0, , , Shape1.Left, Shape1.Top, Shape1.Width, Shape1.Height
End Sub

Private Sub Command1_Click()
CopyPicArea
SavePicture Picture2.Image, App.Path & "\111.jpg"
Shape1.Visible = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Shape1.Top = Y
Shape1.Left = X
Shape1.Width = 1
Shape1.Height = 1
Shape1.Visible = True
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Shape1.Width = Abs(X - Shape1.Left)
Shape1.Height = Abs(Y - Shape1.Top)
End If
End Sub