VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmNewProject 
   Caption         =   "新項目建立"
   ClientHeight    =   3315
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5850
   LinkTopic       =   "Form1"
   ScaleHeight     =   3315
   ScaleWidth      =   5850
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton CmdView 
      Caption         =   "......................"
      Height          =   375
      Left            =   5040
      TabIndex        =   5
      Top             =   480
      Width           =   495
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   360
      Top             =   1200
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton CmdExit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4200
      TabIndex        =   4
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton CmdNewProCreate 
      Caption         =   "創(chuàng)建新項目"
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1680
      TabIndex        =   2
      Top             =   2280
      Width           =   1215
   End
   Begin VB.TextBox TxtNewProDir 
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   480
      Width           =   2895
   End
   Begin VB.Label LblProNewProject 
      Caption         =   "檢查上述內(nèi)容輸入準確無誤，按創(chuàng)建新項目按鈕"
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   240
      TabIndex        =   3
      Top             =   2280
      Width           =   1335
   End
   Begin VB.Label LblNewProDir 
      Caption         =   "輸入項目名（包括盤符和文件夾)"
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
End
Attribute VB_Name = "FrmNewProject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wgridcol As Integer
Dim wgridrow As Integer

Private Sub CmdExit_Click()
 Unload FrmNewProject
End Sub

'創(chuàng)建新工程
Private Sub CmdNewProCreate_Click()
  Dim Drive1 As String
  Dim Drive2 As String
  Dim Drive3 As String
  Dim path1 As String
  Dim sum As Integer
  Dim I As Long
  Dim J As Long
  For I = 1 To Len(g_ProjectFile)
     If Left$(Right$(g_ProjectFile, I), 1) = "\" Then
        J = I
        GoTo lll
     End If
  Next I
lll:
  g_ProDir = Left(g_ProjectFile, Len(g_ProjectFile) - J)
  If Right$(g_ProDir, 1) <> "\" Then
  Else
    g_ProDir = Left(g_ProDir, Len(g_ProDir) - 1)
  End If
  Drive1 = Left$(UCase$(g_ProDir), 3)
  Drive2 = Left$(CurDir$, 3)
  path1 = Mid$(g_ProDir, 3)
  If Not (Drive1 = "C:\" Or Drive1 = "D:\" Or Drive1 = "E:\") Then
       MsgBox "沒有盤符名,請重輸!"
    Exit Sub
  End If
  If path1 = "" Then
       MsgBox "沒有文件夾名，請重輸!"
       Exit Sub
  End If
  If Right$(UCase(g_ProjectFile), 4) <> ".MDB" Then
        If Left$(Right$(g_ProDir, 4), 1) <> "." Then
                g_ProjectFile = g_ProjectFile & ".Mdb"
             Else
                MsgBox "項目的擴展名名必須是“ Mdb”,請重輸 !"
                Exit Sub
         End If
  End If
  If Drive1 <> Drive2 Then
     ChDrive Drive1
  End If
  If Direxists(path1) Then
  Else
     MkDir path1
  End If
  Call DB_T_Def(I)
  If I <> 0 Then
    MsgBox "Error In DataBase"
    Unload Me
    Exit Sub
  End If
  FrmMain.Caption = g_ProjectFile
  FrmMain.MnuNewProject.Enabled = False
  FrmMain.MnuOpenProject.Enabled = False
  FrmMain.MnuSaveProjectAs.Enabled = True
  FrmMain.MnuCloseProject.Enabled = True
  FrmMain.MnuObsData.Enabled = True
  FrmMain.MnuAdjustCal.Enabled = True
  FrmMain.MnuViewObsData.Enabled = True
  FrmMain.MnuViewResult.Enabled = True
  FrmMain.MenuReportPrn.Enabled = True
   Unload Me
 End Sub

Private Sub Form_Load()
      Me.Left = (Screen.Width - Me.Width) / 2
      Me.Top = (Screen.Height - Me.Height) / 2
End Sub

Function Direxists(path As String) As Boolean
    On Error Resume Next
    Direxists = (Dir$(path & "\nul") <> "")
End Function

Private Sub CmdView_Click()
    CommonDialog1.CancelError = True
    On Error GoTo errhandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = "Project(*.Mdb)|*.Mdb"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowOpen
    TxtNewProDir.Text = CommonDialog1.FileName
errhandler:
End Sub

Private Sub TxtNewProDir_Change()
 g_ProjectFile = TxtNewProDir.Text
End Sub