home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmCreateDB
- BorderStyle = 3 'Fixed Dialog
- Caption = "Create New BTS Database"
- ClientHeight = 2040
- ClientLeft = 1140
- ClientTop = 1515
- ClientWidth = 6690
- Height = 2445
- Left = 1080
- LinkTopic = "Form1"
- LockControls = -1 'True
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 2040
- ScaleWidth = 6690
- ShowInTaskbar = 0 'False
- Top = 1170
- Width = 6810
- Begin VB.CommandButton cmdCancel
- Caption = "&Cancel"
- Height = 525
- Left = 3390
- TabIndex = 3
- Top = 1200
- Width = 1245
- End
- Begin VB.CommandButton cmdOK
- Caption = "&OK"
- Height = 525
- Left = 2040
- TabIndex = 2
- Top = 1200
- Width = 1245
- End
- Begin VB.TextBox txtNew
- Height = 285
- Left = 2790
- TabIndex = 0
- Text = "NEW"
- Top = 300
- Width = 3525
- End
- Begin VB.Label Label1
- Alignment = 1 'Right Justify
- Caption = "New Database Name:"
- Height = 285
- Left = 330
- TabIndex = 1
- Top = 330
- Width = 2355
- End
- Attribute VB_Name = "frmCreateDB"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub cmdCancel_Click()
- Unload frmCreateDB
- End Sub
- Private Sub cmdOK_Click()
- Dim msg, style, r, MDB, LDB
- If Len(Trim(txtNew)) < 1 Then
- MsgBox "You must specify a valid file name for the database.", 48, gProgramTitle
- txtNew.SetFocus
- Exit Sub
- End If
- If InStr(1, txtNew, ".MDB", 1) > 0 Then
- MsgBox "You must not specify an MDB extension.", 48, gProgramTitle
- txtNew.SetFocus
- Exit Sub
- End If
- If InStr(1, txtNew, ".LDB", 1) > 0 Then
- MsgBox "You must not specify an LDB extension.", 48, gProgramTitle
- txtNew.SetFocus
- Exit Sub
- End If
- MDB = Trim(txtNew) + ".MDB"
- If Len(Dir(MDB)) > 0 Then
- msg = "A database by this name already exists. Overwrite it?"
- style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
- r = MsgBox(msg, style, gProgramTitle)
- If r = vbNo Then ' User chose NO.
- txtNew.SetFocus
- Exit Sub
- End If
- End If
- MousePointer = 11
- On Error GoTo cmdOK_SomethingBad1
- FileCopy App.Path + "\TEMPLATE.MDB", App.Path + "\" + MDB
- FileCopy App.Path + "\TEMPLATE.LDB", App.Path + "\" + Trim(txtNew) + ".LDB"
- On Error GoTo cmdOK_SomethingBad2
- 'Load the selected database.
- If Not frmMain.SetDatabase(App.Path + "\" + Trim(txtNew) + ".MDB") Then
- MousePointer = 0
- Beep
- MsgBox "Fatal Error: cannot open " + App.Path + Trim(txtNew) + ".MDB" + ". You may be missing files.", 16, gProgramTitle
- End
- End If
- r = frmMain.formatMainForm()
- MousePointer = 0
- Unload frmCreateDB
- Exit Sub
- cmdOK_SomethingBad1:
- MousePointer = 0
- MsgBox "Problem occured when trying to create new files:" + Err.Description, 48, gProgramTitle
- Exit Sub
- cmdOK_SomethingBad2:
- MousePointer = 0
- Beep
- MsgBox "Fatal Error occured when open new files:" + Err.Description, 16, gProgramTitle
- End
- End Sub
- Private Sub Form_Load()
- Left = (Screen.Width - Width) / 2
- TOP = (Screen.Height - Height) / 2
- MousePointer = 0
- End Sub
-