目的：picture1里面导入原图片，剪切后出现在picture2
picture2属性autosize 已改为true
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then'点击鼠标
x1 = X: y1 = Y: x2 = X: y2 = Y'记录鼠标坐标
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture1.Line (x1, y1)-(x2, y2), mycolor, B '画线
Picture1.Line (x1, y1)-(X, Y), mycolor, B
x2 = X: y2 = Y '记录鼠标坐标
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next '？
If Button = 1 Then'点击鼠标
Picture1.Line (x1, y1)-(X, Y), mycolor, B '画线
PictureClip1.ClipX = IIf(x1 < X, x1, X) '复制x坐标
PictureClip1.ClipY = IIf(y1 < Y, y1, Y) '复制y坐标
PictureClip1.ClipWidth = Abs(X - x1) '复制后宽度
PictureClip1.ClipHeight = Abs(Y - y1) '复制后高度
Picture2.Picture = PictureClip1.Clip '剪裁后的图
End If
|
