凸型平曲线.frm

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

VERSION 5.00
Begin VB.Form frmtxpqx 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "凸型平曲线"
   ClientHeight    =   3795
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   5340
   Icon            =   "凸型平曲线.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3795
   ScaleWidth      =   5340
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame2 
      Caption         =   "计算结果"
      Height          =   2055
      Left            =   0
      TabIndex        =   9
      Top             =   1200
      Width           =   5295
      Begin VB.ListBox List1 
         Height          =   1680
         Left            =   120
         TabIndex        =   10
         Top             =   240
         Width           =   5055
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "原始数据"
      Height          =   1095
      Left            =   0
      TabIndex        =   6
      Top             =   40
      Width           =   5295
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   4080
         TabIndex        =   4
         Text            =   "Text3"
         ToolTipText     =   "切线长"
         Top             =   720
         Width           =   1095
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   2760
         TabIndex        =   2
         Text            =   "Text2"
         ToolTipText     =   "外距"
         Top             =   720
         Width           =   1095
      End
      Begin VB.OptionButton Option2 
         Caption         =   "切线长控制"
         Height          =   255
         Left            =   3960
         TabIndex        =   3
         Top             =   360
         Width           =   1215
      End
      Begin VB.OptionButton Option1 
         Caption         =   "外距控制"
         Height          =   255
         Left            =   2760
         TabIndex        =   1
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1320
         TabIndex        =   0
         Text            =   "Text1"
         ToolTipText     =   "如36°15′45″按36.1545输入"
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "请输入外距或切线长长度   ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   760
         Width           =   2535
      End
      Begin VB.Label Label1 
         Caption         =   "路线偏角  ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关闭"
      Height          =   375
      Left            =   4440
      TabIndex        =   7
      Top             =   3360
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "计算"
      Height          =   375
      Left            =   3480
      TabIndex        =   5
      Top             =   3360
      Width           =   855
   End
End
Attribute VB_Name = "frmtxpqx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'计算

    On Error GoTo handlerror

    List1.Clear
    
    ja = Val(Text1.Text)
    sjwjs = ja
    Call dfmhhd
    pj = hudu
    
    If Option1.Value = True Then
        eh = Val(Text2.Text)
        r = eh / ((1 + pj * pj / 24) / Cos(pj / 2) - 1)
        ls = r * pj
    End If
    If Option2.Value = True Then
        th = Val(Text3.Text)
        r = th / ((1 + pj * pj / 24) * Tan(pj / 2) + pj / 2 - pj * pj * pj / 240)
        ls = pj * r
    End If
    th = (r + ls * ls / 24 / r) * Tan(pj / 2) + ls / 2 - ls * ls * ls / 240 / r / r
    eh = (r + ls * ls / 24 / r) / Cos(pj / 2) - r
    ly = pj * r - ls
    lh = ly + 2 * ls
    
    List1.AddItem ""
    List1.AddItem "    路线偏角（°′″）PJ＝  " + Str(sjwjs)
    List1.AddItem "    圆曲线半径   （m）R ＝  " + Str(Int(r * 1000 + 0.5) / 1000)
    List1.AddItem "    缓和曲线长度 （m）Ls＝  " + Str(Int(ls * 1000 + 0.5) / 1000)
    List1.AddItem "    切线长度     （m）Th＝  " + Str(Int(th * 1000 + 0.5) / 1000)
    List1.AddItem "    外距长度     （m）Eh＝  " + Str(Int(eh * 1000 + 0.5) / 1000)
    List1.AddItem "    中间圆曲线长 （m）Ly＝  " + Str(Int(ly * 1000 + 0.5) / 1000)
    List1.AddItem "    平曲线全长   （m）Lh＝  " + Str(Int(lh * 1000 + 0.5) / 1000)
    
    
    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 & ""
        If Option1.Value = True Then
            frmMain.Text1 = frmMain.Text1 & vbCrLf & "    十、凸型平曲线外距控制计算结果："
        End If
        If Option2.Value = True Then
            frmMain.Text1 = frmMain.Text1 & vbCrLf & "    十、凸型平曲线切线长控制计算结果："
        End If
        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 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 = ""
    Text2.Visible = True
    Text3.Visible = False
    Option1.Value = True
    List1.Clear
    List1.AddItem "长度：米，角度：如36°15′45″按36.1545输入"
    
End Sub

Private Sub Option1_Click()
'外距控制
    
    Text2.Visible = True
    Text3.Visible = False
    
End Sub

Private Sub Option2_Click()
'切线长控制

    Text2.Visible = False
    Text3.Visible = True
    
End Sub