frmmain.frm

三角形闭合差计算程序

    MnuViewTri.Enabled = False
    MnuViewSpfxValue.Enabled = False
End Sub

Private Sub MnuCloseProject_Click()
    Dim nTemp As Integer
    Dim sTemp As String
        If g_ProjectFile = "" Then
            MsgBox "项目没有打开。", , "提示信息！"
            Exit Sub
        End If
        sTemp = "你真的想关闭当前工程吗？"
        nTemp = MsgBox(sTemp, vbYesNo, "信息提示!")
        If nTemp = vbYes Then
            If g_ProjectFile <> "" Then
                aveSetting App.EXEName, "Startup", "Backup", g_ProjectFile
                g_d_Base.Close
                g_MyWs.Close
                Set g_d_Base = Nothing
                Set g_MyWs = Nothing
                frmmain.Caption = ""
                g_ProjectFile = ""
            End If
            StatusBar1.Panels(1).Text = ""
            StatusBar1.Panels(2).Text = ""
            frmmain.MnuNewProject.Enabled = True
            frmmain.MnuOpenProject.Enabled = True
            MnuSaveProjectAs.Enabled = False
            MnuCloseProject.Enabled = False
            'MnuObsData.Enabled = False
            'MnuViewObsData.Enabled = False
            'MnuViewResult.Enabled = False
            MenuReportPrint.Enabled = False
        End If
End Sub

Private Sub MnuExitProject_Click()
    Dim nTemp As Integer
    Dim sTemp As String
    sTemp = "你真的想退出吗？"
    nTemp = MsgBox(sTemp, vbYesNo, "信息提示!")
        If nTemp = vbYes Then
            If g_ProjectFile <> "" Then
                SaveSetting App.EXEName, "Startup", "Backup", g_ProjectFile
                g_d_Base.Close
                g_MyWs.Close
                Set g_d_Base = Nothing
                Set g_MyWs = Nothing
            End If
            End
        End If
End Sub

Private Sub mnuhelpabout_Click()
    Frmabout.Show
End Sub

Private Sub mnuhelptopics_Click()
 Const HelpCNT = &HB
      CommonDialog1.HelpFile = "三角形闭合差计算程序帮助.hlp"
      CommonDialog1.HelpCommand = HelpCNT Or cdlHelpSetContents
      CommonDialog1.ShowHelp
End Sub

Private Sub mnulastproject_Click()
    Dim TmpFile As String, Reply As String
    Dim arecord As Recordset
    If g_ProjectFile <> "" Then
        Reply = "项目 " + g_ProjectFile + " 已经打开！"
        MsgBox Reply, , "信息提示!"
        Exit Sub
    End If

    TmpFile = GetSetting(App.EXEName, "Startup", "Backup")
    
    If Dir(TmpFile) = "" Then
            MsgBox "文件" + TmpFile + "不存在！", , "信息提示!"
            Exit Sub
    End If
        
        If FileLen(TmpFile) <= 0 Then
            MsgBox "文件" + TmpFile + "不存在！", , "信息提示!"
            Exit Sub
        End If
    
    g_ProjectFile = TmpFile
    Set g_MyWs = DBEngine.Workspaces(0)
    Set g_d_Base = g_MyWs.OpenDatabase(g_ProjectFile)
    Me.Caption = g_ProjectFile
    Set arecord = g_d_Base.OpenRecordset("项目信息表", dbOpenTable)
    With arecord
        .MoveFirst
        g_ProDir = .Fields(0)
    End With
    arecord.Close
     '将该项目的基本信息取出
    Set arecord = g_d_Base.OpenRecordset("信息表", dbOpenTable)
    With arecord
        .MoveFirst
        g_Info1 = .Fields(0)
        g_Info2 = .Fields(1)
    End With
    arecord.Close
    If g_Info1 = 1 Then
       StatusBar1.Panels(1).Text = "观测数据已完成"
'       Call TakeValue
    End If
    If g_Info2 = 1 Then
       StatusBar1.Panels(2).Text = "平差计算已完成"
    End If
    frmmain.MnuNewProject.Enabled = False
    frmmain.MnuOpenProject.Enabled = False
    MnuSaveProjectAs.Enabled = True
    MnuCloseProject.Enabled = True
    MnuObsData.Enabled = True
    MnuAdjustCal.Enabled = True
    MnuViewObsData.Enabled = True
    MnuViewResult.Enabled = True
    MenuReportPrn.Enabled = True
End Sub

Private Sub mnunewproject_Click()
Dim Reply As String
    Dim I As Integer
    If g_ProjectFile <> "" Then
      Reply = "项目 " + g_ProjectFile + " 已经打开，关闭或保存后再新建！"
      MsgBox Reply, , "信息提示!"
      Exit Sub
    End If
    Load frmnewproject
    frmnewproject.Show
End Sub

Private Sub mnuopenproject_Click()
 Dim Reply As String
    Dim I As Integer
    Dim arecord As Recordset
    Reply = "项目 " & g_ProjectFile + " 已经打开，关闭或退出后再打开其它项目！"
    If g_ProjectFile <> "" Then
        MsgBox Reply, , "提示信息"
        Exit Sub
    End If
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = "工程 (*.Mdb)|*.Mdb"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowOpen
    g_ProjectFile = CommonDialog1.FileName
    If Dir(g_ProjectFile) = "" Or Len(g_ProjectFile) = 0 Then
        MsgBox ("项目不存在!")
        Exit Sub
    End If
    Set g_MyWs = DBEngine.Workspaces(0)
    Set g_d_Base = g_MyWs.OpenDatabase(g_ProjectFile)
    frmmain.Caption = g_ProjectFile
    Set arecord = g_d_Base.OpenRecordset("项目信息表", dbOpenTable)
    With arecord
        .MoveFirst
        g_ProDir = .Fields(0)
    End With
    arecord.Close
    '将该项目的信息取出
    Set arecord = g_d_Base.OpenRecordset("信息表", dbOpenTable)
    With arecord
        .MoveFirst
        g_Info1 = .Fields(0)
        g_Info2 = .Fields(1)
    End With
    arecord.Close
    If g_Info1 = 1 Then
       StatusBar1.Panels(1).Text = "观测数据已完成"
     End If
    If g_Info2 = 1 Then
       StatusBar1.Panels(2).Text = "平差计算已完成"
    End If
'    Call TakeValue
    frmmain.MnuNewProject.Enabled = False
    frmmain.MnuOpenProject.Enabled = False
    MnuSaveProjectAs.Enabled = True
    MnuCloseProject.Enabled = True
    'MnuObsData.Enabled = True
    'MnuAdjustCal.Enabled = True
    'MnuViewObsData.Enabled = True
    'MnuViewResult.Enabled = True
    MnuReportPrint.Enabled = True
   Exit Sub
End Sub
Private Sub mnureportprint_Click()
    If g_ProjectFile = "" Then
        MsgBox "项目没有打开。", , "提示信息！"
        Exit Sub
    End If
    If g_Info1 = 0 Then
        MsgBox "必须先输入观测数据！", , "信息提示!"
        Exit Sub
    End If
    If g_Info2 = 0 Then
        MsgBox "必须先进行计算！", , "信息提示!"
       Exit Sub
    End If
    Load frmprint
    frmprint.Show
End Sub

Private Sub mnusaveprojectas_Click()
Dim TmpFile As String, Reply As String

If g_ProjectFile = "" Then
    MsgBox "项目没有打开。", , "提示信息！"
    Exit Sub
End If

CommonDialog1.CancelError = True
On Error GoTo errhandler

CommonDialog1.Flags = cdlOFNHideReadOnly

CommonDialog1.Filter = "工程 (*.Mdb)|*.Mdb"

CommonDialog1.FilterIndex = 1

CommonDialog1.ShowOpen
    
    TmpFile = CommonDialog1.FileName
    
    If Trim(UCase(TmpFile)) = Trim(UCase(g_ProjectFile)) Then Exit Sub
    If Dir(TmpFile) <> "" Then
        Reply = MsgBox("项目" + TmpFile + "已存在! 覆盖吗?", vbYesNo + vbCritical + vbDefaultButton2)
        If Reply = vbYes Then
            Kill TmpFile
        Else
            Exit Sub
        End If
    End If
    g_d_Base.Close
    g_MyWs.Close
    Set g_d_Base = Nothing
    Set g_MyWs = Nothing
     FileCopy g_ProjectFile, TmpFile
    g_ProjectFile = TmpFile
    Set g_MyWs = DBEngine.Workspaces(0)
    Set g_d_Base = g_MyWs.OpenDatabase(g_ProjectFile)
    Me.Caption = g_ProjectFile
    Exit Sub
errhandler:
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "New"
            mnunewproject_Click
        Case "Open"
            mnuopenproject_Click
        Case "SaveAs"
            mnusaveprojectas_Click
        Case "Exit"
            MnuExitProject_Click
        Case "Print"
            mnureportprint_Click
        Case "HelpAbout"
            mnuhelpabout_Click
     End Select
End Sub