frmmain.frm

测绘工程中的前方交会,主要是摄影测量中运用的较多

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmMain 
   Caption         =   "前方交会"
   ClientHeight    =   8310
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   9420
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "FrmMain.frx":0000
   ScaleHeight     =   9632.195
   ScaleMode       =   0  'User
   ScaleWidth      =   9420
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   405
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   9420
      _ExtentX        =   16616
      _ExtentY        =   714
      ButtonWidth     =   609
      ButtonHeight    =   556
      Appearance      =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   8
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "New"
            Object.ToolTipText     =   "新项目"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Open"
            Object.ToolTipText     =   "打开项目"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "SaveAs"
            Object.ToolTipText     =   "另存为"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Close"
            Object.ToolTipText     =   "关闭"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Exit"
            Object.ToolTipText     =   "退出"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Calculate"
            Object.ToolTipText     =   "平差计算"
            ImageIndex      =   6
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "View"
            Object.ToolTipText     =   "查看平差结果"
            ImageIndex      =   7
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Print"
            Object.ToolTipText     =   "打印平差结果"
            ImageIndex      =   8
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   240
      Top             =   960
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   15
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   8
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":030A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":041E
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":053E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0652
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0766
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":087A
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":098E
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0AA2
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   7935
      Width           =   9420
      _ExtentX        =   16616
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   2040
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu MnuProject 
      Caption         =   "项目(&P)"
      Begin VB.Menu MnuNewProject 
         Caption         =   "新项目"
         Shortcut        =   ^N
      End
      Begin VB.Menu MnuOpenProject 
         Caption         =   "打开项目"
         Shortcut        =   ^O
      End
      Begin VB.Menu Sep1 
         Caption         =   "-"
      End
      Begin VB.Menu MnuSaveProjectAs 
         Caption         =   "另保存为"
      End
      Begin VB.Menu MnuCloseProject 
         Caption         =   "关闭"
      End
      Begin VB.Menu Sep2 
         Caption         =   "-"
      End
      Begin VB.Menu MnuLastProject 
         Caption         =   "最近打开项目"
      End
      Begin VB.Menu spt3 
         Caption         =   "-"
      End
      Begin VB.Menu MnuExitProject 
         Caption         =   "退出"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu MnuLD 
      Caption         =   "前方交会"
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False



Private Sub Form_Load()
Dim ReturnLength As Long, i As Long
     Me.Left = (Screen.Width - Me.Width) / 2
     Me.Top = (Screen.Height - Me.Height) / 2
     FrmMain.MnuLastProject.Caption = GetSetting(App.EXEName, "Startup", "Backup")
     FrmMain.MnuLastProject.Enabled = True
     If FrmMain.MnuLastProject.Caption = "" Then
          FrmMain.MnuLastProject.Caption = "最新项目"
          FrmMain.MnuLastProject.Enabled = False
     End If
MnuLD.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
          SaveSetting 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 = ""
    
    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 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
MnuLD.Enabled = True
End Sub

Private Sub MnuLD_Click()
 FrmLD.Show
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
    MnuLD.Enabled = True

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