frmhdchd.frm

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

         Top             =   1800
         Width           =   1695
      End
   End
End
Attribute VB_Name = "frmhdchd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public sjwjs, dush, hudu As Double
Public du, fen, miao As Double

Const pi = 3.1415926



Private Sub Check1_Click()
'点击两种边坡调整

    On Error GoTo handlerror
    
    If Check1.Value = 1 Then
        Label8.Visible = True
        Text8.Visible = True
        Label9.Visible = True
        Text9.Visible = True
        Label18.Visible = True
        Else
            Label8.Visible = False
            Text8.Visible = False
            Label9.Visible = False
            Text9.Visible = False
            Label18.Visible = False
    End If
    
    Exit Sub
handlerror:

End Sub

Private Sub Check2_Click()
'路基有超高

    On Error GoTo handlerror
    
    If Check2.Value = 1 Then
        Label10.Visible = True
        Text10.Visible = True
        Label11.Visible = True
        Text11.Visible = True
        Label12.Visible = True
        Text12.Visible = True
        Else
            Label10.Visible = False
            Text10.Visible = False
            Label11.Visible = False
            Text11.Visible = False
            Label12.Visible = False
            Text12.Visible = False
    End If
    
    Exit Sub
handlerror:

End Sub

Private Sub Command1_Click()
'计算

    Dim b As Double, bs As Double, bx As Double
    Dim m As Double, i0 As Double, t As Double, a As Double
    Dim h As Double, hs As Double, hx As Double, bm As Double
    Dim ls As Double, lx As Double, lz As Double
    Dim hds As Double, hdx As Double, ii As Double
    Dim bs1 As Double, bx1 As Double, m1 As Double, h0 As Double

    On Error GoTo handlerror
    
    b = Val(Text1.Text)
    bs = Val(Text2.Text)
    bx = Val(Text3.Text)
    m = Val(Text4.Text)
    i0 = Val(Text5.Text)
    t = Val(Text6.Text)
    a = Val(Text7.Text)
    m1 = Val(Text8.Text)
    h0 = Val(Text9.Text)
    ii = Val(Text10.Text)
    hds = Val(Text11.Text)
    hdx = Val(Text12.Text)
    h = Val(Text13.Text)
    hs = Val(Text14.Text)
    hx = Val(Text15.Text)
    sjwjs = Val(Text16.Text)
    
    Call dfmhhd '度分秒转换为弧度
    
    bm = Val(Text17.Text)
    
    '当有两种边坡坡度
    If Check1.Value = 1 Then
        bs1 = bs + m1 * h0
        bx1 = bx + m1 * h0
        Else
            bs1 = bs
            bx1 = bx
    End If
    
    '有加宽超高
    If Check2.Value = 1 Then
        
        Else
            hds = h '否则为中心高度
            hdx = h
    End If
    
    '正交
    If Option1.Value = True Then
        ls = (bs1 + m * (hds - hs - t) + a) / (1 + m * i0)
        lx = (bx1 + m * (hdx - hx - t) + a) / (1 - m * i0)
    End If
    
    '斜交，洞口与路线平行
    If Option2.Value = True Then
        ls = (bs1 + m * (hds - hs)) / (Cos(hudu) + m * i0)
        lx = (bx1 + m * (hdx - hx)) / (Cos(hudu) - m * i0)
    End If
    
    '斜交，洞口与洞墙垂直
    If Option3.Value = True Then
        ls = (bs1 + m * (hds - hs) - 0.5 * bm * Sin(hudu)) / (Cos(hudu) + m * i0)
        lx = (bx1 + m * (hdx - hx) - 0.5 * bm * Sin(hudu)) / (Cos(hudu) - m * i0)
    End If
    
    
    lz = ls + lx
    
    List1.Clear
    List1.AddItem "    《涵洞长度计算》"
    List1.AddItem "    －－－－原始数据－－－－"
    If Option1.Value = True Then
        List1.AddItem "    " + Option1.Caption + "    √"
        ElseIf Option2.Value = True Then
            List1.AddItem "    " + Option2.Caption + "    √"
            ElseIf Option3.Value = True Then
                List1.AddItem "    " + Option3.Caption + "    √"
                ElseIf Option4.Value = True Then
                    List1.AddItem "    " + Option4.Caption + "    √"
    End If
    
    List1.AddItem "    " + Label1.Caption + "  ＝" + Text1.Text
    List1.AddItem "    " + Label2.Caption + "＝" + Text2.Text
    List1.AddItem "    " + Label3.Caption + "＝" + Text3.Text
    List1.AddItem "    " + Label13.Caption + "  ＝" + Text13.Text
    List1.AddItem "    " + Label14.Caption + "＝" + Text14.Text
    List1.AddItem "    " + Label15.Caption + "＝" + Text15.Text
    List1.AddItem "    " + Label4.Caption + "  ＝" + Text4.Text
    List1.AddItem "    " + Label5.Caption + " ＝" + Text5.Text
    List1.AddItem "    " + Label6.Caption + "  ＝" + Text6.Text
    List1.AddItem "    " + Label7.Caption + "  ＝" + Text7.Text
    
    '不是正交时
    If Option1.Value = False Then
        List1.AddItem "    " + Label16.Caption + "          ＝" + Text16.Text
    End If
    
    '斜交，洞口与洞墙垂直
    If Option3.Value = True Then
        List1.AddItem "    " + Label17.Caption + "  ＝" + Text17.Text
    End If
    
    '路基边坡有两种坡度
    If Check1.Value = 1 Then
        List1.AddItem "    " + Check1.Caption + "    √"
        List1.AddItem "    " + Label8.Caption + "         ＝" + Text8.Text
        List1.AddItem "    " + Label9.Caption + "         ＝" + Text9.Text
    End If
    
    '有加宽超高
    If Check2.Value = 1 Then
        List1.AddItem "    " + Check2.Caption + "    √"
        List1.AddItem "    " + Label10.Caption + "         ＝" + Text10.Text
        List1.AddItem "    " + Label11.Caption + "      ＝" + Text11.Text
        List1.AddItem "    " + Label12.Caption + "      ＝" + Text12.Text
    End If
    
    '涵洞长度
    List1.AddItem "    " + "涵洞上游长度(m)          L上＝" + Trim(Str(Int(ls * 1000 + 0.5) / 1000))
    List1.AddItem "    " + "涵洞下游长度(m)          L下＝" + Trim(Str(Int(lx * 1000 + 0.5) / 1000))
    List1.AddItem "    " + "涵洞总长度  (m)          L总＝" + Trim(Str(Int(lz * 1000 + 0.5) / 1000))
    
    
    
    
    Exit Sub
handlerror:
    xiansh = MsgBox("计算出错，请检查输入的数据后再试试。", vbInformation, "问题提示")

End Sub

Private Sub Command2_Click()
'关闭

    On Error GoTo handlerror

    Unload Me
    
    Exit Sub
handlerror:

End Sub

Private Sub Form_Load()
'启动

    On Error GoTo handlerror
    
    '清空控件内容
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Text9.Text = ""
    Text10.Text = ""
    Text11.Text = ""
    Text12.Text = ""
    Text13.Text = ""
    Text14.Text = ""
    Text15.Text = ""
    Text16.Text = ""
    Text17.Text = ""
    
    List1.Clear
    
    '斜交角度
    Label16.Visible = False
    Text16.Visible = False
    
    '缘石长度
    Label17.Visible = False
    Text17.Visible = False
    
    '隐藏调整参数
    Label8.Visible = False
    Text8.Visible = False
    Label9.Visible = False
    Text9.Visible = False
    Label10.Visible = False
    Text10.Visible = False
    Label11.Visible = False
    Text11.Visible = False
    Label12.Visible = False
    Text12.Visible = False
    
    Label18.Visible = False
    
    Exit Sub
handlerror:

End Sub

Private Sub Option1_Click()
'正交

    On Error GoTo handlerror
    
    Label6.Visible = True
    Text6.Visible = True
    Label7.Visible = True
    Text7.Visible = True
    
    Label16.Visible = False
    Text16.Visible = False
    
    Label17.Visible = False
    Text17.Visible = False
    
    Exit Sub
handlerror:

End Sub

Private Sub Option2_Click()
'斜交，洞口与路线平行

    On Error GoTo handlerror
    
    Label6.Visible = False
    Label7.Visible = False
    Label17.Visible = False
    Text6.Visible = False
    Text7.Visible = False
    Text17.Visible = False
    
    Label16.Visible = True
    Text16.Visible = True
    
    Exit Sub
handlerror:

End Sub

Private Sub Option3_Click()
'斜交，洞口与洞墙垂直

    On Error GoTo handlerror
    
    Label6.Visible = False
    Text6.Visible = False
    Label7.Visible = False
    Text7.Visible = False
    Label17.Visible = True
    Text17.Visible = True
    
    Label16.Visible = True
    Text16.Visible = True
    
    
    Exit Sub
handlerror:

End Sub

Private Sub Option4_Click()
'斜交，考虑路基纵坡影响

    On Error GoTo handlerror
    
    Label6.Visible = False
    Label7.Visible = False
    Label17.Visible = False
    Text6.Visible = False
    Text7.Visible = False
    Text17.Visible = False
    
    Label16.Visible = True
    Text16.Visible = True
    
    Exit Sub
handlerror:

End Sub

Private Sub Text1_Change()
'路基宽度
    
    Dim b As Double

    On Error GoTo handlerror
    
    b = Val(Text1.Text)
    
    Text2.Text = Trim(Str(b / 2))
    Text3.Text = Trim(Str(b / 2))
    
    Exit Sub
handlerror:

End Sub




Public Sub dfmhhd()
'度分秒化弧度
    
    On Error GoTo handlerror
    
    dfm = Abs(sjwjs)
    du = Int(dfm)
    fen = Int(dfm * 100) - du * 100
    miao = dfm * 10000 - du * 10000 - fen * 100
    dush = du + fen / 60 + miao / 3600
    hudu = dush * pi / 180
        
    Exit Sub
handlerror:
    
End Sub