切基线平曲线.frm

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

VERSION 5.00
Begin VB.Form frmqjxpqx 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "切基线平曲线"
   ClientHeight    =   3795
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   5325
   Icon            =   "切基线平曲线.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3795
   ScaleWidth      =   5325
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   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        =   6
      Top             =   3360
      Width           =   855
   End
   Begin VB.Frame Frame2 
      Caption         =   "计算结果"
      Height          =   1695
      Left            =   0
      TabIndex        =   11
      Top             =   1560
      Width           =   5295
      Begin VB.ListBox List1 
         Height          =   1320
         Left            =   120
         TabIndex        =   12
         Top             =   240
         Width           =   5055
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "原始数据"
      Height          =   1455
      Left            =   0
      TabIndex        =   0
      Top             =   40
      Width           =   5295
      Begin VB.TextBox Text4 
         Height          =   270
         Left            =   1320
         TabIndex        =   3
         Text            =   "Text4"
         ToolTipText     =   "单位：m"
         Top             =   1080
         Width           =   1215
      End
      Begin VB.CheckBox Check1 
         Caption         =   "需满足线形协调要求吗？"
         Height          =   255
         Left            =   2760
         TabIndex        =   5
         Top             =   1080
         Width           =   2415
      End
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   3960
         TabIndex        =   4
         Text            =   "Text3"
         ToolTipText     =   "单位：m"
         Top             =   360
         Width           =   1215
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1320
         TabIndex        =   2
         Text            =   "Text2"
         ToolTipText     =   "如36°15′45″按36.1545输入"
         Top             =   720
         Width           =   1215
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1320
         TabIndex        =   1
         Text            =   "Text1"
         ToolTipText     =   "如36°15′45″按36.1545输入"
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label5 
         Caption         =   "基线长度AB＝"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   1080
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "缓和曲线LS＝"
         Height          =   255
         Left            =   2760
         TabIndex        =   10
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "偏角PJb   ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   720
         Width           =   1335
      End
      Begin VB.Label Label1 
         Caption         =   "偏角PJa   ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   360
         Width           =   1095
      End
   End
End
Attribute VB_Name = "frmqjxpqx"
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
    
    ab = Val(Text4.Text)
    ja = Val(Text1.Text)
    sjwjs = ja
    Call dfmhhd
    pja = hudu
    
    jb = Val(Text2.Text)
    sjwjs = jb
    Call dfmhhd
    pjb = hudu
    
    pj = pja + pjb
    A1 = (1 - Cos(pja)) / Sin(pja) + (1 - Cos(pjb)) / Sin(pjb)
    b1 = -ab
    If Check1.Value = 1 Then
        r1 = ab / (A1 + pj * pj / 96 * (1 / Sin(pja) + 1 / Sin(pjb)))
        ls = pj / 2 * r1
        ls = Int(ls)
        Else
            ls = Val(Text3.Text)
    End If
    
    c1 = ls * ls / 24 * (1 / Sin(pja) + 1 / Sin(pjb))
    Call yuecfc
    
    r1 = x1
    If r1 = 0 Then
        xianshi = MsgBox("缓和曲线过长，请重新拟定其值", vbInformation, "问题提示")
        Exit Sub
    End If
    
    ly = pj * r1 - ls
    lh = ly + 2 * ls
    ta = ls / 2 + (r1 - (r1 + ls * ls / 24 / r1) * Cos(pja)) / Sin(pja)
    tb = ls / 2 + (r1 - (r1 + ls * ls / 24 / r1) * Cos(pjb)) / Sin(pjb)
    
    List1.AddItem ""
    List1.AddItem "    偏角   （°′″）PJa＝  " + Str(ja)
    List1.AddItem "    偏角   （°′″）PJb＝  " + Str(jb)
    List1.AddItem "    基线长度     （m）AB＝  " + Str(ab)
    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）TA＝  " + Str(Int(ta * 1000 + 0.5) / 1000)
    List1.AddItem "    后切线长度   （m）TB＝  " + Str(Int(tb * 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 = ""
    Text4.Text = ""
    List1.Clear
    List1.AddItem "长度：米，角度：如36°15′45″按36.1545输入"

End Sub