Programming Tool Box/SIMS_2.iso/bp_6_93/bonus/dmsrc/mainform.txt

Text File | 1995-02-26 | 4KB | 198 lines

Option Explicit

Sub mArrange_Click ()
    Arrange 3
End Sub

Sub mCascade_Click ()
    Arrange 0
End Sub

Sub mCloseDatabase_Click ()

    Dim success As Integer
    success = CloseCurrentDatabase()

End Sub

Sub mCompactDatabase_Click ()

    Dim X As Integer
    Dim fromdb As String

    On Error Resume Next
    cmdialog1.DefaultExt = "mdb"
    cmdialog1.DialogTitle = "Database to Compact From"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4& Or &H1000&
    cmdialog1.Action = 1
    fromdb = cmdialog1.Filename

    If Err <> 32755 Then
    Do
    cmdialog1.Filename = ""
    cmdialog1.DialogTitle = "Database to Compact To"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4&
    cmdialog1.Action = 2
    If Err <> 32755 Then
        If fromdb = cmdialog1.Filename Then
        MsgBox "The FROM and the TO databases may not be the same database", 64, "Data Manager"
        Else
        CompactDatabase fromdb, cmdialog1.Filename
        If Err <> 0 Then
            MsgBox Error$, 64, "Data Manager"
        End If
        End If
    Else
        cmdialog1.Filename = "" 'Cancel ends the operation
    End If
    Loop While fromdb = cmdialog1.Filename
    End If
End Sub

Sub MDIForm_Load ()
    Me.WindowState = 2
    gDatabaseName = ""
    Me.Tag = "Main"

    SetDataAccessOption 1, "vb.ini"
End Sub

Sub MDIForm_QueryUnload (Cancel As Integer, UnloadMode As Integer)

    Dim success As Integer
    Cancel = Not CloseCurrentDatabase()

End Sub

Sub mExit_Click ()
    Unload Me
    End
End Sub

Sub mFile_Click ()
    If gDatabaseName = "" Then
    mCloseDatabase.Enabled = False
    Else
    mCloseDatabase.Enabled = True
    End If
End Sub

Sub mHelpItem_Click (Index As Integer)

    Dim I As Integer
    If Index = 0 Then
    I = Shell("winhelp " + app.Path + "\datamgr.hlp", 1)
    End If
End Sub

Sub mNewDB_Click (Index As Integer)
'If Index is 0 then Access 1.0
'If Index is 1 then Access 1.1

    If CloseCurrentDatabase() Then
    OpenNewDatabase cmdialog1, Abs(Index - 1)
    End If


End Sub

Sub mOpenAccess_Click ()
    Dim X As Integer

    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Access"
    End If


End Sub

Sub mOpenBTrieve_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Btrieve"
    End If
End Sub

Sub mOpenDbase_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "dBase III"
    End If


End Sub

Sub mOpendBaseIV_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "dBase IV"
    End If

End Sub

Sub mOpenFox_Click (Index As Integer)
    If Index = 0 Then
    If CloseCurrentDatabase() Then
        OpenADatabase cmdialog1, "FoxPro 2.0"
    End If
    Else
    If CloseCurrentDatabase() Then
        OpenADatabase cmdialog1, "FoxPro 2.5"
    End If
    End If
End Sub

Sub mOpenODBC_Click ()

    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "ODBC"
    End If


End Sub

Sub mOpenParadox_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Paradox 3.X"
    End If


End Sub

Sub mRepairDatabase_Click ()

    On Error Resume Next
    cmdialog1.DefaultExt = "mdb"
    cmdialog1.DialogTitle = "Database to Repair"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4& Or &H1000&
    cmdialog1.Action = 1

    If Err <> 32755 Then
    RepairDatabase cmdialog1.Filename
    If Err <> 0 Then
        MsgBox Error$, 64, "Data Manager"
    End If
    End If

End Sub

Sub mTile_Click ()
    Arrange 1
End Sub

Sub mWindow_Click ()
    If gDatabaseName = "" Then
    mCascade.Enabled = False
    mtile.Enabled = False
    mArrange.Enabled = False
    Else
    mCascade.Enabled = True
    mtile.Enabled = True
    mArrange.Enabled = True
    End If
End Sub