frmmain.frm

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

    
    Exit Sub
handlerror:

End Sub


Private Sub menushtsj_Click()
'水泥砼路面设计

    On Error GoTo handlerror
    
    frmsntshj.Show vbModal, Me
    
    Exit Sub
handlerror:

End Sub

Private Sub menuxxfc_Click()
'线性方程

    On Error GoTo handlerror
    
    frmxxfc.Show vbModal, Me
    
    Exit Sub
handlerror:

End Sub

Private Sub menuysdhd_Click()
'压实度厚度评定

    On Error GoTo handlerror
    
    frmysdhd.Show vbModal, Me
    
    Exit Sub
handlerror:

End Sub

Private Sub menuzhxhup_Click()
'锥形护坡

    On Error GoTo handlerror
    
    frmzhxhp.Show vbModal, Me
    
    Exit Sub
handlerror:

End Sub

Private Sub mnuFileNew_Click()
'新建

    On Error GoTo handlerror
    
    If Trim$(Text1.Text) <> "" Then
        xianshi = MsgBox("请问，是否要保存数据文件？", vbExclamation + vbYesNoCancel, "问题提示")
        If xianshi = 6 Then      '是
            Call mnuFileSaveAs_Click
            Text1.Text = ""
        End If
        If xianshi = 7 Then     '否
            Text1.Text = ""
        End If
        If xianshi = 2 Then     '取消
            Exit Sub
        End If
    End If
    
    If Trim$(Text1.Text) = "" Then
        Text1.Text = ""
    End If
    
    bcwjpd = 0
    
    Exit Sub
handlerror:
    
End Sub

Private Sub mnuHelpAbout_Click()
'关于本程序

    frmAbout.Show vbModal, Me
    
End Sub


Private Sub mnuEditPaste_Click()
'粘贴
    
    On Error GoTo handlerror
    
    Text1.SelText = Clipboard.GetText
    
    Exit Sub
handlerror:

End Sub

Private Sub mnuEditCopy_Click()
'复制

    On Error GoTo handlerror
   
        Clipboard.SetText Text1.SelText
   
    Exit Sub
handlerror:
   
End Sub

Private Sub mnuEditCut_Click()
'剪切
    
    On Error GoTo handlerror
    
    Clipboard.Clear
    
    wenb = Text1.SelText
    Text1.SelText = ""
    Clipboard.SetText wenb
    
    Exit Sub
handlerror:

End Sub

Private Sub mnuFileExit_Click()
'退出程序

    On Error GoTo handlerror

    If Trim$(Text1.Text) <> "" And bcwjpd = 1 Then
        xianshi = MsgBox("请问，是否要保存数据文件？", vbYesNoCancel + vbExclamation, "问题提示")
        If xianshi = 6 Then      '是
            Call mnuFileSave_Click
            Text1.Text = ""
        End If
        If xianshi = 2 Then     '取消
            Exit Sub
        End If
    End If
    
    End
    
    Exit Sub
handlerror:

End Sub

Private Sub mnuFilePrint_Click()
'打印

  
    On Error GoTo handlerror
    
    frmdyyl.vp.PrintDoc (False)
    
    Exit Sub
handlerror:

End Sub

Private Sub mnuFilePrintPreview_Click()
'打印预览

    frmdyyl.Show vbModal, Me
    
End Sub

Private Sub mnuFilePageSetup_Click()
'页面设置

On Error Resume Next
    
    frmyemsz.Show vbModal, Me

End Sub

Private Sub mnuFileSaveAs_Click()
'另存为

    wjlj = ""
    
    If Trim(Text1.Text) <> "" Then
        If wjlj = "" Then
            CommonDialog1.CancelError = True
            On Error GoTo handlerror
            
            CommonDialog1.InitDir = App.Path & "\"
            CommonDialog1.Filter = "公路测设(*.gcs)|*.gcs|all files(*.*)|*.*"
            CommonDialog1.ShowSave
            FileName = CommonDialog1.FileName
            wjlj = FileName
        End If
        Open FileName For Output As #1
         
            Print #1, Text1.Text
            
        Close #1
    End If
    
    frmMain.Caption = "饮羽公路测设" + "    " + wjlj
    
    bcwjpd = 0

    Exit Sub
handlerror:

End Sub

Private Sub mnuFileSave_Click()
'保存文件

    If Trim(Text1.Text) <> "" And bcwjpd = 1 Then
        If wjlj = "" Then
            CommonDialog1.CancelError = True
            On Error GoTo handlerror
            
            CommonDialog1.InitDir = App.Path & "\"

            CommonDialog1.Filter = "公路测设(*.gcs)|*.gcs|all files(*.*)|*.*"
            CommonDialog1.ShowSave
            FileName = CommonDialog1.FileName
            wjlj = FileName
        End If
        Open wjlj For Output As #1
         
            Print #1, Text1.Text
            
        Close #1
    End If
    
    frmMain.Caption = "饮羽公路测设" + "    " + wjlj
    
    bcwjpd = 0

    Exit Sub
handlerror:

End Sub

Private Sub mnuHlp_Click()
'帮助文件

    frmbzwjct.Show vbModal, Me

End Sub

Private Sub plfbzft_Click()
'频率分布直方图

    frmplfbzft.Show vbModal, Me

End Sub

Private Sub qjxpqx_Click()
'切基线平曲线
    
    frmqjxpqx.Show vbModal, Me
    
End Sub

Private Sub quxfs_Click()
'曲线反算

    frmqxfsu.Show vbModal, Me

End Sub

Private Sub qxckz_Click()
'切线长控制程序
    
    frmqxckz.Show vbModal, Me
    
End Sub


Private Sub rjzhuy_Click()
'软件主页
    Dim ret&
    
    On Error GoTo handlerror
    
    ret& = ShellExecute(Me.hwnd, "Open", "http://www.yycost.com", "", App.Path, 1)

    
    Exit Sub
handlerror:

End Sub

Private Sub sdyqxfs_Click()
'三点圆曲线设计

    frmsdyqxsj.Show vbModal, Me

End Sub

Private Sub sgwltjs_Click()
'施工网络图

    frmsgwlt.Show vbModal, Me

End Sub


Private Sub shntlmphb_Click()
'水泥砼路面配合比

    frmshntpb.Show vbModal, Me

End Sub

Private Sub shzcl_Click()
'水准测量

    frmshzcl.Show vbModal, Me
    
End Sub

Private Sub sqxjs_Click()
'竖曲线计算

    frmsqxjs.Show vbModal, Me

End Sub

Private Sub sxqxsj_Click()
'S型曲线设计

    frmsxqxsj.Show vbModal, Me

End Sub

Private Sub Text1_Change()
'如果文件况变化则需保存文件

    On Error GoTo handlerror
    
    bcwjpd = 1
    
    Exit Sub
handlerror:

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "xinjian"
            Call mnuFileNew_Click
        Case "dakai"
            Call dakai_Click
        Case "baoc"
            Call mnuFileSave_Click
        Case "yulan"
            Call mnuFilePrintPreview_Click
        Case "dayin"
            Call mnuFilePrint_Click
        Case "jianqie"
            Call mnuEditCut_Click
        Case "fuzhi"
            Call mnuEditCopy_Click
        Case "niantie"
            Call mnuEditPaste_Click
        Case "zuoduiq"
            Text1.Alignment = 0
        Case "juzhong"
            Text1.Alignment = 2
        Case "youduiq"
            Text1.Alignment = 1
            
        Case "ziti"
            CommonDialogziti.CancelError = True
            dlgCommonDialog.Flags = cdlCFBoth Or cdlCFEffects
            dlgCommonDialog.ShowFont
            Text1.Font.Name = dlgCommonDialog.FontName
            Text1.Font.Size = dlgCommonDialog.FontSize
            Text1.Font.Bold = dlgCommonDialog.FontBold
            Text1.Font.Italic = dlgCommonDialog.FontItalic
            Text1.Font.Underline = dlgCommonDialog.FontUnderline
            Text1.FontStrikethru = dlgCommonDialog.FontStrikethru
            Text1.ForeColor = dlgCommonDialog.Color
            
        
            
    End Select
End Sub

Private Sub tqdpd_Click()
'水泥砼强度评定

    frmqdpd.Show vbModal, Me

End Sub

Private Sub txqxsj_Click()
'凸型平曲线

    frmtxpqx.Show vbModal, Me
    
End Sub

Private Sub tyzhb_Click()
'缓和曲线统一坐标计算

    frmtyzhb.Show vbModal, Me

End Sub

Private Sub wjkzh_Click()
'外距控制
    frmwjkzh.Show vbModal, frmMain
End Sub

Private Sub xjdpqx_Click()
'虚交点平曲线
    frmxjdpqx.Show vbModal, Me
End Sub

Private Sub xxghqj_Click()
'线性规划求解

    frmghqj.Show vbModal, Me

End Sub

Private Sub yyqxnh_Click()
'一元曲线拟合

    frmyyqxnh.Show vbModal, Me

End Sub

Private Sub zdljjs_Click()
'最短路径计算

    frmzdljjs.Show vbModal, Me

End Sub

Private Sub zhbzhh_Click()
'坐标转换

    frmzhbzh.Show vbModal, Me

End Sub

Private Sub zhijkzh_Click()
'支距控制
    frmzjkz.Show vbModal, frmMain
End Sub

Private Sub zzddzb_Click()
'中桩大地坐标
    
    frmzzddzb.Show vbModal, Me

End Sub