为什么我用vb画的图形不能够随意移动

Question

本帖最后由 bcrun 于 2012-08-20 19:56:12 编辑

Answer 1

http://download.csdn.net/detail/veron_04/1894278

Answer 2

如果是到处移动的话，要加一个timer吧？在timer加一个判断才好吧

Answer 3

在 picture1_MouseMove() 中：①把 If r1 < r Then  ......  End if 这一层去掉。
②再把这两句改下：
　　yuanx = yuanx + X - x4
　　yuany = yuany + Y - y4
改成：
  yuanx = X - x4
  yuany = Y - y4

Answer 4

你应将图形视为一个对象，所谓移动只是更改对象的坐标，更改时不要有绘制对象的操作，否则逻辑上很难处理！绘制的操作应交给pictureBox的paint事件中完成,给你一个示例：Option Explicit
'表单上先添加一个命令按钮，Caption为“画圆工具”
'一个picture,属性默认
'该程序允许你用鼠标画圆并调整大小和位置Private Type typCIRCLE '圆结构
    r As Single
    X As Single
    Y As Single
End Type
Private Type HITTESTDATA  '命中测试结果
    ID As Integer
    rlt As Byte  '0内部，1边缘，2外部
End Type
Private Enum ESTATE  '状态
    Move = 0   '移动图形
    Add = 1   '画新图
    Size = 2   '改变图形大小
End Enum
Dim 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 = Add
Picture1.MousePointer = 2
End Sub
Private Sub Form_Load()
CurrSelected = -1
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Select 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 = Y
End Select
Picture1.Refresh
End If
End Sub
Private Function HitTest(X As Single, Y As Single) As HITTESTDATA '测试选中了哪个图形
Dim obj As typCIRCLE, i, rlt As HITTESTDATA
rlt.ID = -1
rlt.rlt = 2
For 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 If
Next
HitTest = rlt
End FunctionPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Select 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 If
End Select
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
State = Move
Picture1.MousePointer = 0
End SubPrivate Sub Picture1_Paint()  '所有绘制操作在这里完成
Dim i As Integer
For 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 If
Next
End Sub

Answer 5

Picture1.AutoRedraw = True