home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Unleashed
/
Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso
/
source
/
chap36
/
createdb.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1995-08-03
|
4KB
|
118 lines
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