切线长控制.frm

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

VERSION 5.00
Begin VB.Form frmqxckz 
   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        =   10
      Top             =   1200
      Width           =   5295
      Begin VB.ListBox List1 
         Height          =   1680
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   5055
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "原始数据"
      Height          =   1095
      Left            =   0
      TabIndex        =   5
      Top             =   40
      Width           =   5295
      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.TextBox Text2 
         Height          =   270
         Left            =   1320
         TabIndex        =   1
         Text            =   "Text2"
         ToolTipText     =   "单位：m"
         Top             =   720
         Width           =   1215
      End
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   3960
         TabIndex        =   2
         Text            =   "Text3"
         ToolTipText     =   "单位：m"
         Top             =   360
         Width           =   1215
      End
      Begin VB.CheckBox Check1 
         Caption         =   "需满足线形协调要求吗？"
         Height          =   255
         Left            =   2760
         TabIndex        =   3
         Top             =   720
         Width           =   2415
      End
      Begin VB.Label Label1 
         Caption         =   "路线偏角  ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "控制切线长Th＝"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   720
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "缓和曲线LS＝"
         Height          =   255
         Left            =   2760
         TabIndex        =   7
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关闭"
      Height          =   375
      Left            =   4440
      TabIndex        =   6
      Top             =   3360
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "计算"
      Height          =   375
      Left            =   3480
      TabIndex        =   4
      Top             =   3360
      Width           =   855
   End
End
Attribute VB_Name = "frmqxckz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Check1_Click()
'点击复选框
    
    If Check1.Value = 1 Then
        Text3.Text = ""
        Text3.Enabled = False
        Else
            Text3.Enabled = True
    End If
    
End Sub

Private Sub Command1_Click()
'计算
    
    On Error GoTo handlerror
    
    List1.Clear
    
    If Val(Text1.Text) = 0 Or Val(Text2.Text) = 0 Or Val(Text3.Text) = 0 And Check1.Value = 0 Then
        xianshi = MsgBox("请输入必须的数据后计算。", vbInformation, "问题提示")
    End If
    
    sjwjs = Val(Text1.Text)
    th = Val(Text2.Text)
    ls = Val(Text3.Text)
    
    Call dfmhhd
    
    If Check1.Value = 1 Then
        r1 = th / ((1 + hudu * hudu / 96) * Tan(hudu / 2) + hudu / 4 - hudu * hudu * hudu / 1920)
        ls = hudu / 2 * r1
        ls = Int(ls)
    End If
    
    A1 = Tan(hudu / 2)
    b1 = ls / 2 - th
    c1 = Tan(hudu / 2) * ls * ls / 24
    
    Call yuecfc
    
    r1 = x1
    If r1 = 0 Then
        Beep
        xianshi = MsgBox("缓和曲线长度或外距过小" & vbCrLf & "请重新拟定其值", vbInformation, "问题提示")
        Exit Sub
    End If
    th = (r1 + ls * ls / 24 / r1) * Tan(hudu / 2) + ls / 2
    eh = (r1 + ls * ls / 24 / r1) / Cos(hudu / 2) - r1
    ly = hudu * r1 - ls
    lh = ly + 2 * ls
    
    List1.AddItem ""
    List1.AddItem "    路线偏角（°′″）PJ＝  " + Str(sjwjs)
    List1.AddItem "    圆曲线半径   （m）R ＝  " + Str(Int(r1 * 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 & ""
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    二、切线长控制曲线计算结果："
        
        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 = ""
    List1.Clear
    List1.AddItem "长度：米，角度：如36°15′45″按36.1545输入"
        
End Sub