如何在图形上用鼠标捕捉数据线及读取所捕捉数据线点对应数值,请高手指点

Question

有一组检测数据形成了二维数组suzu1(1,1)=-20,suzu1(1,2)=-18,suzu1(1,3)=-5,suzu1(1,4)=8,suzu1(1,5)=12,suzu1(1,6)=-3,.....suzu(1,5000)=0,我据此数据在PICTURE1上绘制成一条连续折线:picture1.style=2
picture1.line (0,200)-(5000,200)'画X轴横虚线picture1.style=0
for i=1 to 5000-1
picture1.line (i,suzu(1,i))-(i+1,suzu(1,i+1))'据数据画一条实心折线
next i
画好上述线后.如何实现当鼠标在picture1上移动,当靠近此线或已经移动到此线上时,点击鼠标,立即把该线该点所对应的数组值弹出来提示数值大小.

Answer 1

自定义一个坐标系统，编写PictureBox的MouseDown事件，显示坐标即可。

Answer 2

如何定义坐标系统?picturebox 和PICTURE1不一样吗?
我感觉我在PICTURE上LINE就已经是利用了坐标系统.
请问自定义坐标系统有插件吗?这坐标是和图上的点位一一对应?要存储图上各点位的数据吗?

Answer 3

picture1.line (i,500-suzu(1,i))-(i+1,500-suzu(1,i+1))'据数据画一条实心折线
问题栏中此名句未把X轴横线所在Y点500加上去,上面这句补加一下

Answer 4

picture1.Scale (x1,y1)-(x2,y2)上面这条语句就是自定义坐标系统的语句，(x1,y1)是坐标系中Picture1左上角坐标，(x2,y2)是坐标系中Picture1右下角坐标

Answer 5

我要绘制的数组是suzu(0,0-16,picture1.width).即一张图上有16条横线.有时有一条横线的数据绘制出的拆线图上下波动很大,会穿越几条横线.当给制出这些折线后,在图上移动鼠标如何确定鼠标移到了某条折线并显示此条折线此处的数据.请提供一下代码好吗?

Answer 6

MouseMove 事件,Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call Picture1_MouseDown(Button, Shift, x, y)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'Picture1.Drag
    mx = x
    my = y
    'Picture1.Drag Picture2
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If mx <> 0 And my <> 0 Then
                Picture2.Left = Picture2.Left + (x - mx) '/ Screen.TwipsPerPixelX
                Picture2.Top = Picture2.Top + (y - my) ' / Screen.TwipsPerPixelX
    End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Ctl As Variant
    If mx <> 0 And my <> 0 Then
                Picture2.Left = Picture2.Left + (x - mx) '/ Screen.TwipsPerPixelX
                Picture2.Top = Picture2.Top + (y - my) ' / Screen.TwipsPerPixelX
                mx = x
                my = y
    End If
    'Debug.Print X, Screen.TwipsPerPixelX
End Sub
类似这样的东东，根据鼠标位置来判断，与哪个数据相关，然后显示出那个数据

Answer 7

还是不懂~~~~可能是我描述我想要的功能描述得有问题.
我再简化一下我所想要的功能吧:
FORM1窗体里有一个PICTURE1
FORM1_LOAD()
for I=0 TO PICTURE1.WIDTH'x方向
DATA=INT(400*RND())'随机生成0-400的数值
SUZU1(I)=DATA'将随机生成的DATA赋值给数组
NEXT I'据随机生成的数组值绘制曲线
PICY=500
PICTURE1.LINE (0,PICY)-(PICTURE1.WIDTH,PICY)'画一X横线
for I=0 TO PICTURE1.WIDTH-1'x方向PICTURE1.LINE (I,PICY-SUZU1(I))-(I+1,PICY-SUZU1(I+1)NEXT I
这样,我就在PICTURE1上画好了这条随机连接折线
我要如何实现当鼠标移到画好线的位置时显示此线在鼠标所在点的SUZU值?

Answer 8

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)End Subx,y是当前鼠标的坐标，你自定义坐标系，画图后suzu1当y坐标，你鼠标移动到画好的线上的y坐标就是suzu1的值，

Answer 9

我想对应图上的点位建立一个二维数组与PICTURE1图上各点位的数值一一对应,画图时给对应的点位进行赋值,这样在图上移移动鼠标时就能据鼠标的X,Y来判断显示数值.但是在REDIM数组时提示溢出:
'定义动态数组
            Dim pic9bit()
            ReDim pic9bit(0 To Picture9.Width, 0 To Picture9.Height)'提示内存溢出'对图位对应数组初始化赋值
            For P9wX = 0 To Picture9.Width
                For P9wY = 0 To Picture9.Height
                    pic9bit(P9wX, P9wY) = Null
                Next P9wY
            Next P9wX
            For P9wX = 0 To (chaxunx1 - chaxunx0) - 1
            
                For P9wY = 1 To 12
'相邻两条线用不同的颜色画线
                    If P9wY Mod 2 = 0 Then
                        Picture9.Line (pic9x11, pic9y11)-(pic9x12, pic9y12), &H8000&
                    Else
                        Picture9.Line (pic9x11, pic9y11)-(pic9x12, pic9y12), vbRed
                    End If
'将所画这条线对应的图点位数组进行赋值
                    For P9wX1 = pic9x11 To pic9x12
                        For P9wY1 = pic9y11 To pic9y11
                            If pic9y12 = pic9y11 * pic9x12 / pic9x11 Then
                                pic9bit(P9wX1, P9wY1) = tudianyulichen(P9wY, chaxunx0 + P9wX)
                            End If
                             Next P9wY1
                    Next P9wX1
                Next P9wY
             Next P9wX
看来此方法行不通.
请问该如何是好??????????????

Answer 10

Option Explicit
'一维数组足够你画线了
Dim a(0 To 10) As Long
Private Sub Form_Load()
Dim i As Long
'随机赋值
For i = 0 To 10
        a(i) = Rnd * 10
Next i
'自定义坐标,左上角坐标是0,10, 右下角坐标是10,0
Picture1.Scale (0, 10)-(10, 0)
With Picture1
        '画X 蓝色
        .ForeColor = vbBlue
        For i = 0 To 10
               Picture1.Line (0, i)-(10, i)
        Next i
        '画Y,绿色
        .ForeColor = vbGreen
        For i = 0 To 10
               Picture1.Line (i, 0)-(i, 10)
        Next i
        '画线
        .ForeColor = vbBlack
        '宽度10(这个单位是原始的,和自定义坐标系没关系
        .DrawWidth = 10
        '数据的第一个点作为曲线的第一个点
        Picture1.PSet (0, a(0))
        For i = 1 To 10
                Picture1.Line -(i, a(i))
        Next i
End With
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'系统给的x坐标就是数组的下标,这样转换一下就可以作为数组下标了,x是单精度
'这样y坐标就是a(int(x))
MsgBox Int(X) & " " & a(Int(X))
End Sub

Answer 11

判断点在线段上，根据解析几何的方法很容易做到：先由两端点坐标得到线段所在直线的方程，把欲判断的点的坐标代入方程就可以了，考虑到鼠标和显示的精度问题，可改为判断点是否落在以线段为核心的一片矩形区域内，这里给出一段：'点类型
Type POINT
    x As Single
    y As Single
End Type
'测试点是否在线段上，考虑到鼠标精度，实际测试点是否在线段周边一定范围内
Private Function PtInSegment(pt As POINT, lpt1 As POINT, lpt2 As POINT) As Boolean
'pt,待测试的点，lpt1,lpt2线段的两个端点
'求和线段平行的两条直线方程
Dim A As Single, B As Single, C As Single    '直线方程的系数
A = (lpt2.y - lpt1.y)
B = lpt1.x - lpt2.x
C = -(A * lpt1.x) + (-B) * lpt1.y
Dim d As Single, absC As Single
d = 60   '误差范围，可修改,即线段到和线段平行的两条直线的距离
absC = d * Sqr(A ^ 2 + B ^ 2)Dim testRlt As Boolean
'点是否落在和线段平行的两条线所夹范围内
testRlt = (A * pt.x + B * pt.y + C < absC) And (A * pt.x + B * pt.y + C > -absC)'求和线段垂直的两条直线方程
Dim C1 As Single, C2 As Single
C1 = -B * lpt1.x + A * lpt1.y
C2 = -B * lpt2.x + A * lpt2.y
'点是否落在和线段垂直的两条线所夹范围内
testRlt = testRlt And (B * pt.x - A * pt.y + C1 < 0 And B * pt.x - A * pt.y + C2 > 0)
PtInSegment = testRlt
End Function

Answer 12

按你所述的方法,那我可以将每个线段参数和线段所对应的数值生成数据库.鼠标移动时与数据库SQL查询判断是否在此范围内,是则光标变形,点击则弹出对话框提示数据.这样想能搞得通不?

Answer 13

数据存在什么地方不重要，也和SQL没啥关系！你不会连解析几何也没学过吧？
给你个完整的示例，你复制到工程中运行体会一下：'运行前你的form上得有个Picture1
Option Explicit
'点
Private Type POINT
    X As Single
    Y As Single
End Type
'线段
Private Type Segment
    P1 As POINT
    P2 As POINT
End TypeDim Segments(0 To 20) As Segment   '存放线段端点坐标
Dim SelectIndex As Integer  '选中线段的索引Private Sub Form_Load()
Dim i As Integer
'随机生成多条线段,并画在picture1中
For i = 0 To 20
    Segments(i).P1.X = Rnd(1) * Picture1.Width
    Segments(i).P1.Y = Rnd(1) * Picture1.Height
    Segments(i).P2.X = Rnd(1) * Picture1.Width
    Segments(i).P2.Y = Rnd(1) * Picture1.Height
    Picture1.Line (Segments(i).P1.X, Segments(i).P1.Y)-(Segments(i).P2.X, Segments(i).P2.Y), RGB(0, 0, 0)
Next
End Sub'测试点是否在线段上，考虑到鼠标精度，实际测试点是否在线段周边一定范围内
Private Function PtInSegment(pt As POINT, lpt1 As POINT, lpt2 As POINT) As Boolean
'pt,待测试的点，lpt1,lpt2线段的两个端点
'求和线段平行的两条直线方程
Dim A As Single, B As Single, C As Single    '直线方程的系数
A = (lpt2.Y - lpt1.Y)
B = lpt1.X - lpt2.X
C = -(A * lpt1.X) + (-B) * lpt1.Y
Dim d As Single, absC As Single
d = 60   '误差范围，可修改,即线段到和线段平行的两条直线的距离
absC = d * Sqr(A ^ 2 + B ^ 2)Dim testRlt As Boolean
'点是否落在和线段平行的两条线所夹范围内
testRlt = (A * pt.X + B * pt.Y + C < absC) And (A * pt.X + B * pt.Y + C > -absC)'求和线段垂直的两条直线方程
Dim C1 As Single, C2 As Single
C1 = -B * lpt1.X + A * lpt1.Y
C2 = -B * lpt2.X + A * lpt2.Y
'点是否落在和线段垂直的两条线所夹范围内
testRlt = testRlt And (B * pt.X - A * pt.Y + C1 < 0 And B * pt.X - A * pt.Y + C2 > 0)
PtInSegment = testRlt
End Function'点击显示线段信息
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox "你选中的线段是第" & SelectIndex & "条，端点坐标：(" & Segments(SelectIndex).P1.X & "," & Segments(SelectIndex).P1.Y & ")-(" _
                                                        & Segments(SelectIndex).P2.X & "," & Segments(SelectIndex).P2.Y & ")"
End Sub'鼠标经过则选中，并显示为红色
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim hitRlt As Integer
hitRlt = HitTest(X, Y)
If hitRlt >= 0 Then
    Picture1.Line (Segments(hitRlt).P1.X, Segments(hitRlt).P1.Y)-(Segments(hitRlt).P2.X, Segments(hitRlt).P2.Y), RGB(255, 0, 0)
    If SelectIndex <> -1 And SelectIndex <> hitRlt Then
        Picture1.Line (Segments(SelectIndex).P1.X, Segments(SelectIndex).P1.Y)-(Segments(SelectIndex).P2.X, Segments(SelectIndex).P2.Y), RGB(0, 0, 0)
        SelectIndex = hitRlt
    End If
End If
End Sub'测试点在那条线段上,在则返回索引，不在则返回-1
Private Function HitTest(X As Single, Y As Single) As Integer
Dim i As Integer
Dim pt As POINT
pt.X = X
pt.Y = Y
For i = 0 To 20
    If PtInSegment(pt, Segments(i).P1, Segments(i).P2) Then
        Exit For
    End If
Next
If i <= 20 Then
    HitTest = i   '点在线段上，返回索引号
Else
    HitTest = -1  '否则返回-1
End If
End Function