为什么我用vb画的图形不能够随意移动
Dim x1, y1, x2, y2, x3, y3, x4, y4, r, r1 As SingleDim i As BooleanDim yuanx, yuany As SinglePrivate Sub Command1_Click()i = TruePicture1.ClsEnd SubPrivate Sub Form_Load() Picture1.Width = 1200 '定义画图界面的宽度 Picture1.Height = 1200 '定义画图界面的高度 Picture1.ScaleWidth = 1200 Picture1.ScaleHeight = 1200 xlen = Picture1.ScaleWidth / 2 ylen = Picture1.ScaleHeight / 2 Picture1.Scale (-xlen, ylen)-(xlen, -ylen) Picture1.Line (-xlen, 0)-(xlen, 0) '定义X轴 Picture1.Line (0, -ylen)-(0, ylen) '定义Y轴End SubPrivate Sub picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 1 Then If i = True Then '画圆 x1 = X: y1 = Y ElseIf i = False Then '移动 x4 = X: y4 = Y End If End IfEnd SubPrivate Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then If i = True Then 'Picture1.AutoRedraw = False Picture1.Refresh Picture1.MousePointer = 1 Picture1.Cls r = Sqr((X - x1) ^ 2 + (Y - y1) ^ 2) Picture1.Circle (x1, y1), r yuanx = x1: yuany = Y '用鼠标改变圆的位置 ElseIf i = False Then r1 = Sqr((x4 - yuanx) ^ 2 + (y4 - yuany) ^ 2) If r1 < r Then Picture1.MousePointer = 5 Picture1.Cls yuanx = yuanx + X - x4: yuany = yuany + Y - y4 Picture1.Circle (yuanx, yuany), r End If End If End IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) i = FalseEnd Sub
Option Explicit'表单上先添加一个命令按钮，Caption为“画圆工具”'一个picture,属性默认'该程序允许你用鼠标画圆并调整大小和位置Private Type typCIRCLE '圆结构 r As Single X As Single Y As SingleEnd TypePrivate Type HITTESTDATA '命中测试结果 ID As Integer rlt As Byte '0内部，1边缘，2外部End TypePrivate Enum ESTATE '状态 Move = 0 '移动图形 Add = 1 '画新图 Size = 2 '改变图形大小End EnumDim c(100) As typCIRCLE, CCount As Integer '最多101个圆Dim State As ESTATE, CurrSelected As Integer, oldX As Single, oldY As SinglePrivate Sub Command1_Click()State = AddPicture1.MousePointer = 2End SubPrivate Sub Form_Load()CurrSelected = -1End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbLeftButton ThenSelect Case State Case ESTATE.Add c(CCount).X = X c(CCount).Y = Y CurrSelected = CCount CCount = CCount + 1 Case ESTATE.Move, ESTATE.Size '可用鼠标选中图形 Dim rlt As HITTESTDATA rlt = HitTest(X, Y) CurrSelected = rlt.ID If rlt.rlt = 0 Then '如果点中圆内部 State = Move Else If rlt.rlt = 1 Then '如果点中圆边缘 State = Size End If End If oldX = X oldY = YEnd SelectPicture1.RefreshEnd IfEnd SubPrivate Function HitTest(X As Single, Y As Single) As HITTESTDATA '测试选中了哪个图形Dim obj As typCIRCLE, i, rlt As HITTESTDATArlt.ID = -1rlt.rlt = 2For i = CCount To 0 Step -1 obj = c(i) If (X - obj.X) ^ 2 + (Y - obj.Y) ^ 2 < (obj.r + 100) ^ 2 Then rlt.ID = i rlt.rlt = 0 If (X - obj.X) ^ 2 + (Y - obj.Y) ^ 2 > (obj.r - 100) ^ 2 Then rlt.rlt = 1 End If HitTest = rlt Exit Function End IfNextHitTest = rltEnd FunctionPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbLeftButton ThenSelect Case State Case ESTATE.Add c(CurrSelected).r = Sqr((X - c(CurrSelected).X) ^ 2 + (Y - c(CurrSelected).Y) ^ 2) Picture1.Refresh Case ESTATE.Move If CurrSelected >= 0 Then c(CurrSelected).X = c(CurrSelected).X + (X - oldX) c(CurrSelected).Y = c(CurrSelected).Y + (Y - oldY) oldX = X oldY = Y Picture1.Refresh End If Case ESTATE.Size If CurrSelected >= 0 Then c(CurrSelected).r = Sqr((X - c(CurrSelected).X) ^ 2 + (Y - c(CurrSelected).Y) ^ 2) Picture1.Refresh End IfEnd SelectEnd IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)State = MovePicture1.MousePointer = 0End SubPrivate Sub Picture1_Paint() '所有绘制操作在这里完成Dim i As IntegerFor i = 0 To CCount If i = CurrSelected Then Picture1.DrawWidth = 3 '被选中者高亮显示 Picture1.Circle (c(i).X, c(i).Y), c(i).r, RGB(255, 0, 0) Else Picture1.DrawWidth = 1 Picture1.Circle (c(i).X, c(i).Y), c(i).r End IfNextEnd Sub
