在VB中删除最后一条画出的直线?
在VB中添加一个图片和一个按钮控件,在图片控件中连续画出三条直线然后按按钮控件取消最后一条直线后显示先画的两条直线请问该怎么写程序呢PrivateSubPicture2_...
在VB中添加一个图片和一个按钮控件,在图片控件中连续画出三条直线然后按按钮控件取消最后一条直线后显示先画的两条直线请问该怎么写程序呢
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.Refresh
Picture2.Line (startx, starty)-(X, Y) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub 展开
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.Refresh
Picture2.Line (startx, starty)-(X, Y) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub 展开
展开全部
楼上的Command1_Click()背景色重画存在问题。当直线相交时(且DrawWidth比较大时),会出现有一条线的相交点处竟然断了。
解决的方案如下:
Dim startx As Single, starty As Single
Dim endx As Single, endy As Single
Dim bDraw As Boolean '注意
Private Sub Command1_Click()
bDraw = False
Picture2.Cls
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
If bDraw Then '注意
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy)
bDraw = False
End If
Picture2.AutoRedraw = False
startx = X
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X
endy = Y
Picture2.Refresh
Picture2.Line (startx, starty)-(endx, endy)
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X
endy = Y
bDraw = True '注意
End Sub
Private Sub Picture2_Paint() '注意
If bDraw Then Picture2.Line (startx, starty)-(endx, endy)
End Sub
解决的方案如下:
Dim startx As Single, starty As Single
Dim endx As Single, endy As Single
Dim bDraw As Boolean '注意
Private Sub Command1_Click()
bDraw = False
Picture2.Cls
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
If bDraw Then '注意
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy)
bDraw = False
End If
Picture2.AutoRedraw = False
startx = X
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X
endy = Y
Picture2.Refresh
Picture2.Line (startx, starty)-(endx, endy)
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X
endy = Y
bDraw = True '注意
End Sub
Private Sub Picture2_Paint() '注意
If bDraw Then Picture2.Line (startx, starty)-(endx, endy)
End Sub
展开全部
把下面代码全粘贴进去:这个方法是保存最后一条线的起、止坐标,点击按钮command1就重在最后一条线上用背景色画一条线。但是这个方法不能达到完美删除,因为线条重合的话,线条交叉处的点也被擦了。
要想完美的话,再加一个pictureBox用于保存最后一次之前的状态,点击按钮后把图复制回去。
Dim startx As Single, starty As Single
Dim endx As Single, endy As Single
Private Sub Command1_Click()
Picture2.Line (startx, starty)-(endx, endy), Picture2.BackColor '用背景色画一条线
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.Refresh
Picture2.Line (startx, starty)-(endx, endy) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub
要想完美的话,再加一个pictureBox用于保存最后一次之前的状态,点击按钮后把图复制回去。
Dim startx As Single, starty As Single
Dim endx As Single, endy As Single
Private Sub Command1_Click()
Picture2.Line (startx, starty)-(endx, endy), Picture2.BackColor '用背景色画一条线
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.Refresh
Picture2.Line (startx, starty)-(endx, endy) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub
追问
什么办法能达到完美删除呢,用背景线覆盖的方法我会,就是按钮后不显示也不存在最后一条线,或者说是像用ctrl+z一样返回上一步或是擦除最后一条直钱,有擦除直线的语句吗
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询