Question

VB中的MOUSEDOWN问题!

用VB做了的读曲线软件.曲线是由好多个点连线起来显示在FORM的PICTURE1里面的!现在用MOUSEDOWN点击去曲线坐标.由于肉眼精度问题.无法准确点取那些点.都点在附近.有什么办法可以点上那些曲线的点.就近原则吧.离哪个近就显示哪个的坐标.曲线的点以外的不显示!

Answer 1

'新建窗体，添加command1,picture1,在picture1里添加shape1,复制粘贴下段代码：

Dim ypos(1 To 100) As Long, xpos(1 To 100) As Long '定义两个数组存放坐标

'初始化控件
Private Sub Form_Load()
Me.Tag = 0 '设置画过标志为0
Command1.Caption = "描点" '按钮标题
Picture1.BackColor = vbBlack 'picture1背景黑色
Picture1.AutoRedraw = True '设置重画标志为true
Shape1.Shape = 3 '设置shape1为圆形
Shape1.BorderWidth = 3 '边框宽度
Shape1.BorderColor = vbRed '边框颜色红色
Shape1.Height = 200 '高度
Shape1.Width = 200 '宽度
Shape1.Visible = False '不可见
End Sub

'描点
Private Sub Command1_Click()
Picture1.Cls '重新描点时刷新 picture1
Randomize '初始化随机函数
For i = 1 To 100 '循环为xpos,ypos赋值
xpos(i) = i * Picture1.Width \ 100 '横坐标单位为picture1宽度的百分之一
ypos(i) = Int(Rnd * (Picture1.Height - 1001) + 500) '纵坐标为picture1高度上下减去500范围内的随机值
Picture1.DrawWidth = 5 '设置picture1笔刷大小为5
Picture1.ForeColor = vbWhite '设置 picture1的前景色白色
Picture1.PSet (xpos(i), ypos(i)) '描关键点
Picture1.DrawWidth = 1 '设置picture1笔刷大小为1
Picture1.ForeColor = vbBlue '设置picture1前景色蓝色
If i > 1 Then Picture1.Line (xpos(i), ypos(i))-(xpos(i - 1), ypos(i - 1)) '画线
Next
Me.Tag = 1 '设置画过标志
End Sub

'捕捉点
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Tag <> 1 Then Exit Sub '如果没画退出
For i = 1 To 100 '循环检测关键点
DoEvents '移交控制权
If Sqr((X - xpos(i)) ^ 2 + (Y - ypos(i)) ^ 2) < 100 Then '如果距关键点距离小于100
Shape1.Move xpos(i) - 90, ypos(i) - 80 '移动shape1到该关键点
Shape1.Visible = True 'shape1可见
Picture1.ToolTipText = xpos(i) & "," & ypos(i) '设置picture1提示
Exit Sub '退出过程
Else
Shape1.Visible = False '若距离关键点距离大于100,shape1不可见
End If
Next

'如果是捕捉曲线上的每一点可以用point方法返回颜色值，通过判断颜色值捕捉，代码如下
'If Picture1.Point(X, Y) = vbBlue Then
'Shape1.Move X - 90, Y - 80
'Shape1.Visible = True
'Picture1.ToolTipText = X & "," & Y
'Exit Sub
'Else
'Shape1.Visible = False
'End If

End Sub

'点击显示坐标
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shape1.Visible = True Then MsgBox Picture1.ToolTipText
End Sub

Answer 2

给你一个参考,没有测试,不知道正不正确,但原理应该是正确的
Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
添加上面的API函数

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sysColor as long '用于存放曲线的颜色
Dim Theta as Integer,X0 as Long, Y0 as Long
sysColor=vbRed '根据实际情况更改
Dim R as Double
R=10 '从点击位置开始,搜索的最大半径
For i=0 to R Step R/10 'Step的值为精度,可以更改
For Theta =0 to 360 '判断该半径下一个圆周
X0=Clng(X+i*Cos(theta*3.1415926/180))
Y0=Clng(Y+i*Sin(theta*3.1415926/180))
If GetPixel(Picture1.Hdc,X0,Y0)=sysColor Then
Print X0,Y0
Goto OutFor
End If
Next
Next
OutFor:
End Sub

Answer 3

用MOUSE的坐标点的坐标，如果这个差的绝对值小于某个数，就认为它们是一个点。用这个思路可以解决你的问题。