用vb编写一个直线拟合程序

新建窗体，添加text1,command1,picture1
Private Sub Command1_Click()
If Text1.Text = "" Then Exit Sub
Dim x() As Single, y() As Single, cnt As Integer
Dim xmax As Single, xmin As Single, ymax As Single, ymin As Single
Dim p() As String, z() As String
Dim xyh As Single, xh As Single, yh As Single, xph As Single, k As Single, b As Single
p = Split(Text1.Text, "/")
For i = 0 To UBound(p)
    If p(i) <> "" Then
        z = Split(p(i), "*")
        If UBound(z) = 1 Then
            If IsNumeric(z(0)) And IsNumeric(z(1)) Then
                If cnt = 0 Then xmax = z(0): xmin = z(0): ymax = z(1): ymin = z(1)
                If xmax < z(0) Then xmax = z(0)
                If xmin > z(0) Then xmin = z(0)
                If ymax < z(1) Then ymax = z(1)
                If ymin > z(1) Then ymin = z(1)
                xyh = xyh + z(0) * z(1): xh = xh + z(0): yh = yh + z(1): xph = xph + z(0) ^ 2
                ReDim Preserve x(cnt), y(cnt)
                x(cnt) = z(0): y(cnt) = z(1): cnt = cnt + 1
            End If
        End If
    End If
Next
Picture1.Cls
Picture1.DrawWidth = 1
If xmax = xmin And ymax = ymin Then
    MsgBox "单点无法拟合"
ElseIf xmax = xmin Then
    Picture1.Scale (xmin * 0.5, ymax + 0.2 * (ymax - ymin))-(xmin * 1.5, ymin - 0.2 * (ymax - ymin))
    zuobiaozhou xmin * 0.5, ymax + 0.2 * (ymax - ymin), xmin * 1.5, ymin - 0.2 * (ymax - ymin)
    Picture1.Line (xmax, ymax + 0.2 * (ymax - ymin))-(xmax, ymin - 0.2 * (ymax - ymin)), vbBlue
ElseIf ymax = ymin Then
    Picture1.Scale (xmin - 0.2 * (xmax - xmin), ymax * 1.5)-(xmax + 0.2 * (xmax - xmin), ymin * 0.5)
    zuobiaozhou xmin - 0.2 * (xmax - xmin), ymax * 1.5, xmax + 0.2 * (xmax - xmin), ymin * 0.5
    Picture1.Line (xmin - 0.2 * (xmax - xmin), ymax)-(xmax + 0.2 * (xmax - xmin), ymax), vbBlue
Else
    Picture1.Scale (xmin - 0.2 * (xmax - xmin), ymax + 0.2 * (ymax - ymin))-(xmax + 0.2 * (xmax - xmin), ymin - 0.2 * (ymax - ymin))
    zuobiaozhou xmin - 0.2 * (xmax - xmin), ymax + 0.2 * (ymax - ymin), xmax + 0.2 * (xmax - xmin), ymin - 0.2 * (ymax - ymin)
    k = (xyh - (xh * yh) / cnt) / (xph - xh ^ 2 / cnt)
    b = yh / cnt - k * xh / cnt
    Picture1.Line (xmin - 0.2 * (xmax - xmin), k * (xmin - 0.2 * (xmax - xmin)) + b)-(xmax + 0.2 * (xmax - xmin), k * (xmax + 0.2 * (xmax - xmin)) + b), vbBlue
End If
Picture1.DrawWidth = 5
For i = 0 To cnt - 1
Picture1.PSet (x(i), y(i)), vbRed
Next
Text1.SetFocus
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text1.ToolTipText = "横纵坐标间以乘号*分隔，各点间以除号/分隔。例如：100*100/200*200"
Command1.Caption = "绘图"
Picture1.AutoRedraw = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If Not (IsNumeric(Chr(KeyAscii)) Or KeyAscii = 8 Or KeyAscii = 42 Or KeyAscii = 45 Or KeyAscii = 46 Or KeyAscii = 47) Then KeyAscii = 0
End Sub
Function zuobiaozhou(ByVal x1 As Single, y1 As Single, x2 As Single, y2 As Single)
For i = x1 + (x2 - x1) / 5 To x2 Step (x2 - x1) / 5
    Picture1.Line (i, y2 + 100 * (y1 - y2) / Picture1.Height)-(i, y2)
    Picture1.CurrentX = i - 250 * (x2 - x1) / Picture1.Width
    Picture1.CurrentY = y2 + 350 * (y1 - y2) / Picture1.Height
    Picture1.Print i
Next
For i = y2 + (y1 - y2) / 5 To y1 Step (y1 - y2) / 5
    Picture1.Line (x1, i)-(x1 + 100 * (x2 - x1) / Picture1.Width, i)
    Picture1.CurrentX = x1 + 150 * (x2 - x1) / Picture1.Width
    Picture1.CurrentY = i + 80 * (y1 - y2) / Picture1.Height
    Picture1.Print i