一元曲线逆合.frm

饮羽公路测设（glcs） 由20多个公路测量、设计、试验和施工组织设计等小软件组成。如《中桩大地坐标》可以计算不等长缓和曲线的中桩和边桩的大地坐标；《缓和曲线反算》可以根据切线长、外距长或缓和曲线长求

    For i = 1 To VSFlexGrid1.Rows - 1
        xa(i) = Val(VSFlexGrid1.TextMatrix(i, 1))
        ya(i) = Val(VSFlexGrid1.TextMatrix(i, 2))
    Next i
    
    yc = Val(Text2.Text)
    
    y1 = 0
    y2 = 0
    cx = 0
    cy = 0
    xy = 0
    xx = 0
    yy = 0
    sx = 100000000
    sy = 100000000
    mx = -100000000
    my = -100000000
    For i = 1 To m
        x = xa(i)
        y = ya(i)
        y1 = y1 + y
        y2 = y2 + y * y
        If x > mx Then mx = x
        If x < sx Then sx = x
        If y > my Then my = y
        If y < sy Then sy = y
        If md > 0 Then Call yian
        cx = cx + x
        cy = cy + y
        xy = xy + x * y
        xx = xx + x * x
        yy = yy + y * y
    Next i
    
    xx = xx - cx * cx / m
    yy = yy - cy * cy / m
    xy = xy - cx * cy / m
    y2 = y2 - y1 * y1 / m
    d = xy / xx
    c = (cy - d * cx) / m
    b = d
    a = c
    u = d * xy
    q = yy - u
    r = Sqr(u / yy)
    e = Sqr(q / (m - 2))
    F = u / q * (m - 2)
    v = Sqr(y2 / (m - 1))
    Call xian
    
    List1.Clear
    
    List1.AddItem "回归系数  B＝" + Str(Int(b * 10000 + 0.5) / 10000)
    List1.AddItem "常数项    A＝" + Str(Int(a * 10000 + 0.5) / 10000)
    List1.AddItem "相关系数  R＝" + Str(Int(r * 10000 + 0.5) / 10000)
    List1.AddItem "复相关系数F＝" + Str(Int(F * 10000 + 0.5) / 10000)
    
    List1.AddItem ""
    List1.AddItem "序号 数据Xi Yi 拟合值(Y) 差值Y-(Y)"
    
    For i = 1 To m
        x = xa(i)
        y = ya(i)
        Call xian
        List1.AddItem Str(i) + "  " + Str(x) + "  " + Str(y) + "  " + Str(Int(z * 1000 + 0.5) / 1000) + "  " + Str(Int((y - z) * 1000 + 0.5) / 1000)
    Next i
    
    List1.AddItem ""
    
    Text3.Visible = True
    Text3.SetFocus
    Command3.Enabled = True
    
    Exit Sub
handlerror:
    xianshi = MsgBox("请检查输入的数据后再计算。", vbInformation, "问题提示")

End Sub

Private Sub Command2_Click()
'关闭

    On Error GoTo handlerror
    
    If List1.ListCount > 1 And rjsfzc = 88 Then
        frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    《一元曲线拟合计算结果》："
        
        frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    实验数据数目＝" + Text1.Text
        If md > 5 Then frmMain.Text1 = frmMain.Text1 & vbCrLf & "    常数Yc＝" + Text2.Text
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    曲线公式＝" + Str(dm) + "号"
        
        For i = 0 To List1.ListCount - 1
            frmMain.Text1 = frmMain.Text1 & vbCrLf & "    " + List1.List(i)
        Next i
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    --------------------------------------"
    End If
    
    Unload Me
    
    Exit Sub
handlerror:
    
End Sub

Private Sub Command3_Click()
'推测结果

    x = Val(Text3.Text)
    Call xian
    
    List1.AddItem "    X=" + Str(x) + "    " + "y=" + Str(Int(z * 1000 + 0.5) / 1000)
    Text3.Text = ""
    Text3.SetFocus

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
    On Error GoTo handlerror

    If KeyAscii = 27 Then
        Unload Me
    End If
    
    Exit Sub
handlerror:

End Sub

Private Sub Form_Load()
'启动

    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text3.Visible = False
    Command3.Enabled = False
    
    List1.Clear
    
    VSFlexGrid1.TextMatrix(0, 0) = "序号"
    VSFlexGrid1.TextMatrix(0, 1) = "数据Xi"
    VSFlexGrid1.TextMatrix(0, 2) = "数据Yi"
    
    VSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter
    VSFlexGrid1.ColAlignment(1) = flexAlignCenterCenter
    VSFlexGrid1.ColAlignment(2) = flexAlignCenterCenter
    VSFlexGrid1.ColWidth(0) = 500
    VSFlexGrid1.ColWidth(1) = 1000
    VSFlexGrid1.ColWidth(2) = 1000
    
    Label2.Visible = False
    Text2.Visible = False
    

End Sub

Private Sub Option1_Click()
'不显示常数
    
    md = 0
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option2_Click()
'不显示常数
    
    md = 1
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option3_Click()
'不显示常数
    
    md = 2
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option4_Click()
'不显示常数
    
    md = 3
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option5_Click()
'不显示常数
    
    md = 4
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option6_Click()
'不显示常数
    
    md = 5
    Label2.Visible = False
    Text2.Visible = False
    Text2.Text = ""

End Sub

Private Sub Option7_Click()
'显示常数

    md = 6
    Label2.Visible = True
    Text2.Visible = True
    Text2.Text = ""
    
End Sub

Private Sub Option8_Click()
'显示常数

    md = 7
    Label2.Visible = True
    Text2.Visible = True
    Text2.Text = ""
    
End Sub

Private Sub Text1_Change()
'实验数目

    If Val(Text1.Text) >= 1 Then
        VSFlexGrid1.Rows = Val(Text1.Text) + 1
        For i = 1 To VSFlexGrid1.Rows - 1
            VSFlexGrid1.TextMatrix(i, 0) = i
        Next i
    End If

End Sub

Public Sub yian()
'因变量线形化分程序
    
    Select Case md
        Case Is = 1
            y = Log(y)
            x = Log(x)
        Case Is = 2
            y = Log(y)
        Case Is = 3
            y = Log(x)
            x = 1 / x
        Case Is = 4
            x = Log(x)
        Case Is = 5
            y = 1 / y
            x = 1 / x
        Case Is = 6
            y = Log(yc / y - 1)
        Case Is = 7
            y = Log(1 - y / yc)
    End Select

End Sub

Public Sub xian()
'求拟合值分程序
    
    Select Case md
        Case Is = 0
            z = a + b * x
        Case Is = 1
            a = Exp(c)
            z = a * x ^ b
        Case Is = 2
            a = Exp(c)
            z = a * Exp(b * x)
        Case Is = 3
            a = Exp(c)
            z = a * Exp(b / x)
        Case Is = 4
            z = a + b * Log(x)
        Case Is = 5
            z = x / (a * x + b)
        Case Is = 6
            z = yc / (1 + Exp(a + b * x))
        Case Is = 7
            a = -c / d
            b = -d
            z = yc * (1 - Exp(-b * (x - a)))
    End Select
    
End Sub