home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmMainForm
- Appearance = 0 'Flat
- BackColor = &H0080FFFF&
- BorderStyle = 3 'Fixed Dialog
- Caption = "Network Diagramming"
- ClientHeight = 1905
- ClientLeft = 780
- ClientTop = 1800
- ClientWidth = 5115
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 2595
- Icon = "NETDIAG.frx":0000
- Left = 720
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 1905
- ScaleWidth = 5115
- Top = 1170
- Width = 5235
- Begin MSComDlg.CommonDialog ctlCDialog
- Left = 480
- Top = 600
- _Version = 65536
- _ExtentX = 847
- _ExtentY = 847
- _StockProps = 0
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFileNewDBase
- Caption = "&New Database..."
- End
- Begin VB.Menu mnuFileOpen
- Caption = "&Open Database..."
- End
- Begin VB.Menu mnuFileSep1
- Caption = "-"
- End
- Begin VB.Menu mnuFileExit
- Caption = "E&xit"
- End
- End
- Attribute VB_Name = "frmMainForm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- ' -----------------------------------------------------------------------------
- ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
- ' You have a royalty-free right to use, modify, reproduce and distribute
- ' the Sample Application Files (and/or any modified version) in any way
- ' you find useful, provided that you agree that Visio has no warranty,
- ' obligations or liability for any Sample Application Files.
- ' -----------------------------------------------------------------------------
- Option Explicit
- Private Sub mnuFileExit_Click()
- '----------------------------------------
- '--- mnuFileExit_Click ------------------
- '-- Handles request for exit. We prompt before exiting.
- Dim strMsg As String
- strMsg = "Are you sure you want to quit?"
- If MsgBox(strMsg, MB_ICONEXCLAMATION Or MB_YESNO, "Exit") = IDYES Then
- End
- End If
- End Sub
- Private Sub mnuFileNewDBase_Click()
- '----------------------------------------
- '--- mnuFileNewDBase_Click --------------
- '-- Handles the user's request to build a blank database.
- On Error GoTo lblNewDBaseCatchCancelErr
- Dim strFileName As String
- ctlCDialog.DialogTitle = "Create Blank Database"
- ctlCDialog.CancelError = True
- ctlCDialog.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
- ctlCDialog.Filter = "Access Files (*.mdb)|*.mdb"
- ctlCDialog.DefaultExt = "mdb"
- ctlCDialog.Action = 2
- strFileName = ctlCDialog.filename
- On Error GoTo lblKillCatch
- Kill strFileName
- SetMousePointer MP_WAIT
- CreateBlankDatabase strFileName
- SetMousePointer MP_NORMAL
- MsgBox strFileName & " Created.", MB_ICONINFORMATION, ""
- Exit Sub
- lblNewDBaseErr:
- MsgBox "Error creating blank database." & Chr(13) & Chr(10) & Error
- Exit Sub
- Resume Next
- lblNewDBaseCatchCancelErr:
- Exit Sub
- Resume Next
- lblKillCatch:
- Resume Next
- End Sub
- Private Sub mnuFileOpen_Click()
- '----------------------------------------
- '--- mnuFileOpen_Click ------------------
- '-- The process for creating a network diagram requires we first prompt for
- '-- an Access database name. If the user selects a file we then verify it
- '-- is OK for diagramming (ValidDatabase) and if so we create the diagram.
- Dim strFileName As String
- On Error GoTo lblFileOpenErr
- ctlCDialog.DialogTitle = "Open Network Database"
- ctlCDialog.Filter = "Access Files (*.mdb)|*.mdb"
- ctlCDialog.CancelError = True
- ctlCDialog.Action = 1
- strFileName = ctlCDialog.filename
- If ValidDatabase(strFileName) Then
- SetMousePointer MP_WAIT
- CreateDiagram (strFileName)
- SetMousePointer MP_NORMAL
- Else
- MsgBox "Invalid Database", MB_ICONEXCLAMATION, "Open"
- End If
- Exit Sub
- lblFileOpenErr:
- Exit Sub
- Resume Next
- End Sub
-