在一张坐标纸上，随意画一条曲线，然后能不能找到一些点和这条曲线接近，并且把点表示出来呢？请问各位高手谁知道这种算法或是程序代码类似也可以？？？急求呢！！ - 编程论坛

#2

yz10252012-11-05 01:38

有个偷懒的方法～
利用MouseDown()和MouseMove()和MouseUp()～
加上一个Timer()～时间间隔看你～
当你划线时取座标值连续写入阵列～
这样就不用算法了～

#3

yz10252012-11-05 01:40

话说你的坐标纸....
该不会不在电脑里吧？

#4

QYCqyc2012-11-05 08:58

回复 2楼 yz1025

求您指点一下，有点不会……？？能不能详细说明一下呢！

#5

ccwu22012-11-05 15:10

Timer1.Interval越小坐标越多准越准确...
但是要划出曲线就要另外把代码加到里面了...
也很简单用API几行而已...前题是你画在Form上...

程序代码：

Option Explicit

Dim A() As String, X1 As Integer, Y1 As Integer, nCount As Long

Private Sub Form_Load()
    nCount = 0: ReDim A(nCount)
    Timer1.Interval = 500
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer1.Enabled = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Timer1.Enabled = True Then
        X1 = X: Y1 = Y
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
    ReDim Preserve A(nCount)
    A(nCount) = X1 & "," & Y1
    List1.AddItem A(nCount), nCount
    nCount = nCount + 1
End Sub

#6

ccwu22012-11-05 15:32

画图的代码...
跟上面部分代码组合起来就是你边画图边记点了...

程序代码：

Dim x1 As Integer   '起点X坐标
Dim y1 As Integer   '起点Y坐标
Dim x2 As Integer   '终点点X坐标
Dim y2 As Integer   '终点Y坐标
Dim flag As Boolean '绘图标志

'设置线的颜色
Private Sub Command1_Click()
    On Error Resume Next
    CommonDialog1.CancelError = True
    CommonDialog1.DialogTitle = "颜色"
    CommonDialog1.ShowColor
    If Err <> 32755 Then
        Picture1.ForeColor = CommonDialog1.Color
    End If
End Sub

'清除Picture1中的图形
Private Sub Command2_Click()
    Picture1.Cls
End Sub

'设置线宽
Private Sub Option1_Click()
    Picture1.DrawWidth = 1
End Sub

Private Sub Option2_Click()
    Picture1.DrawWidth = 2
End Sub

Private Sub Option3_Click()
    Picture1.DrawWidth = 4
End Sub

Private Sub Option4_Click()
    Picture1.DrawWidth = 8
End Sub

Private Sub Form_Load()
    Picture1.Scale (0, 0)-(400, 400)
    flag = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'当按下鼠标按键时绘图开始并记录最初的起点
    flag = True
    x1 = X
    y1 = Y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'如果不是处在绘图状态则退出该过程
'如果处在绘图状态则从起点到目前鼠标所在点绘制直线
'然后将当前鼠标所在点作为新的起点
    If flag = False Then
        Exit Sub
    End If
    If flag = True Then
        x2 = X
        y2 = Y
        Picture1.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'当释放鼠标按键时绘图结束
    flag = False
End Sub