急用 好心人帮帮忙 小妹在此谢过了
使用VB设计一个绘图软件能够用鼠标右键选择是画点还是画直线(可以绘制不同图形) --------------------编程问答-------------------- 作业题自己做,还有,我不信每个求助的都是小妹,漂亮妞…… --------------------编程问答-------------------- 看在有20分的份上,小妹小哥都不要紧了。给段代码你,可以实现画线和画圆功能。首先添加一个菜单,标题:hidemenu 名称:hidemenu
在其下添加两个子菜单,标题:线段 名称:Builder ,索引:0
标题:圆 名称:Builder,索引:1
然后添加个picture、label、line、shape,名称按默认就行。
最后复制粘贴以下代码:
Private Sub Form_Load()
hidemenu.Visible = False
Picture1.BackColor = RGB(0, 0, 0)
Picture1.AutoRedraw = True
Picture1.Align = 1
Line1.Visible = False
Line1.BorderColor = RGB(255, 255, 0)
Shape1.BorderColor = RGB(255, 255, 0)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Button
Case 1
Select Case BuilderState
Case 1 '画线
Select Case BuildClickNm
Case 0
FirstClickX = X
FirstClickY = Y
Line1.X1 = FirstClickX
Line1.Y1 = FirstClickY
Line1.X2 = FirstClickX
Line1.Y2 = FirstClickY
BuildClickNm = 1
Line1.Visible = True
Case 1
'Picture1.FillColor = Line1.BorderColor
Picture1.Line (FirstClickX, FirstClickY)-(X, Y), Line1.BorderColor
FirstClickX = X
FirstClickY = Y
Line1.X1 = FirstClickX
Line1.Y1 = FirstClickY
Case 2
End Select
Case 2 '画圆
Select Case BuildClickNm
Case 0
FirstClickX = X
FirstClickY = Y
Shape1.Shape = 3
Shape1.Left = FirstClickX
Shape1.Top = FirstClickY
Shape1.Height = FirstClickX
Shape1.Width = FirstClickY
Picture1.PSet (FirstClickX, FirstClickY), Line1.BorderColor
BuildClickNm = 1
Shape1.Visible = True
Label1.Caption = ""
Case 1
Dim RX As Long
Dim RY As Long
Dim RUse As Long
RX = Abs(FirstClickX - X)
RY = Abs(FirstClickY - Y)
If RX >= RY Then RUse = RX Else RUse = RY
Picture1.PSet (FirstClickX, FirstClickY), Picture1.BackColor
Picture1.Circle (FirstClickX, FirstClickY), RUse, Shape1.BorderColor
BuildClickNm = 1
Shape1.Visible = False
Label1.Caption = "请选择中心点"
BuildClickNm = 0
End Select
End Select
Case 2
If Picture1.MousePointer = 0 Then
PopupMenu hidemenu
Else
Picture1.MousePointer = 0
Line1.Visible = False
BuildClickNm = 0
BuilderState = 0
End If
End Select
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 0 And BuilderState = 1 And BuildClickNm = 1 Then
Line1.X2 = X
Line1.Y2 = Y
End If
If Button = 0 And BuilderState = 2 And BuildClickNm = 1 Then
Dim RX As Long
Dim RY As Long
Dim RUse As Long
RX = Abs(FirstClickX - X)
RY = Abs(FirstClickY - Y)
If RX >= RY Then RUse = RX Else RUse = RY
RX = FirstClickX - RUse
RY = FirstClickY - RUse
Shape1.Top = RY
Shape1.Left = RX
Shape1.Height = RUse * 2
Shape1.Width = RUse * 2
End If
End Sub
入需其它功能,请参阅前2个进行代码添加。 --------------------编程问答-------------------- 最近小妹比较流行。。。。 --------------------编程问答-------------------- 一直都很流行,我读大小四年,我身边的同学作业不想自己做,也是扮小妹求助 --------------------编程问答-------------------- ~~ --------------------编程问答-------------------- 哈哈.
路过.....
我这里有一个好例子,不过好象用不上了 --------------------编程问答-------------------- 差不多的也可以啊 可以参考,啊 发上来啊 谢谢类 --------------------编程问答-------------------- 2楼的代码不是吗?我知道了,又是想要现成的,调试编译好的对吧? --------------------编程问答-------------------- 哈哈 冒冲小妹 --------------------编程问答--------------------
经典!
补充:VB , 基础类