PC Shareware 2000 January/PCShareware-1-00.iso/trials/Fc7/ABC.Z/NETWORK.FRM

Visual Basic Form | 1997-08-13 | 15.5 KB | 480 lines

VERSION 4.00
Begin VB.Form NetworkDatabaseDemo
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Network Database Demo"
   ClientHeight    =   1950
   ClientLeft      =   1245
   ClientTop       =   2190
   ClientWidth     =   5265
   ClipControls    =   0   'False
   BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   2355
   Icon            =   "NETWORK.frx":0000
   Left            =   1185
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1950
   ScaleWidth      =   5265
   Top             =   1845
   Width           =   5385
   Begin VB.CommandButton BrowseBtn
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Browse..."
      Height          =   375
      Left            =   3690
      TabIndex        =   6
      Top             =   795
      Width           =   1335
   End
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   4350
      Picture         =   "NETWORK.frx":030A
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   4
      Top             =   195
      Width           =   495
   End
   Begin VB.Data Data1
      Appearance      =   0  'Flat
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   270
      Left            =   1440
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "Network"
      Top             =   3600
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.CommandButton cmdCancel
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   2640
      TabIndex        =   2
      Top             =   1440
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1065
      TabIndex        =   1
      Top             =   1440
      Width           =   1335
   End
   Begin VB.TextBox Text1
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   105
      TabIndex        =   0
      Top             =   840
      Width           =   3465
   End
   Begin MSComDlg.CommonDialog OpenDatabaseFile
      Left            =   120
      Top             =   1440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
   End
   Begin AbcflowLib.ABC ABC1
      Left            =   4320
      Top             =   1440
      _Version        =   65536
      _ExtentX        =   1085
      _ExtentY        =   873
      _StockProps     =   1
   End
   Begin VB.Label Label2
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "Press ""Browse"" to choose another database."
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   840
      TabIndex        =   5
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Database File:"
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   1245
   End
   Begin VB.Line Line1
      BorderColor     =   &H00FFFFFF&
      X1              =   0
      X2              =   5280
      Y1              =   1320
      Y2              =   1320
   End
Attribute VB_Name = "NetworkDatabaseDemo"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
    Dim ABC As Object
    Dim NetSource As RECORD
    Dim UserName As String
    Dim DataBaseFile As String
    Dim TestFileValid As String
    Dim FlowVersion As Double
    Const DATA_ERRCONTINUE = 1
    Const DATA_ERRDISPLAY = 0
    Const OFN_FILEMUSTEXIST = &H1000&
    Const OFN_PATHMUSTEXIST = &H800&
Private Sub ABC1_AppQuitNOTIFY()
    Data1.Recordset.Close
    End
End Sub
Private Sub ABC1_DoubleClickSUBCLASS(ByVal Object As Object, ByVal Chart As Object, Override As Boolean)
    Dim Obj As Object
    Set Obj = ABC1.Chart.Objects.ItemFromText(".mdb")
    If Obj.Valid Then
        ' Get the database from the chart
        Data1.DatabaseName = Obj.Text
        GetDatabaseInfo (Object.Text)
    Else

    End If
    Override = True
End Sub
Private Sub BrowseBtn_Click()
    'In case of error
    On Error Resume Next
    'Set properties here
    OpenDatabaseFile.CancelError = True
    OpenDatabaseFile.DefaultExt = "mdb"
    OpenDatabaseFile.Filter = "Database Files(*.mdb)|*.mdb"
    OpenDatabaseFile.Flags = OFN_FILEMUSTEXIST And OFN_PATHMUSTEXIST
    OpenDatabaseFile.Action = 1
    'Close if cancelled
    If Err = 32755 Then
        Exit Sub
    Else
        DataBaseFile = OpenDatabaseFile.filename
    End If

    Text1.Text = DataBaseFile
End Sub
Private Sub cmdCancel_Click()
     Unload NetworkDatabaseDemo
     End
End Sub
Private Sub cmdOK_Click()
    Dim DataBaseFileOne As Integer
    Dim DataBaseFileTwo As Integer
    Err = 0
    DataBaseFile = Text1.Text
    DataBaseFileOne = InStr(DataBaseFile, "NETBASE1.MDB")
    DataBaseFileTwo = InStr(DataBaseFile, "NETBASE2.MDB")
    If Not DataBaseFileOne > 1 And DataBaseFileTwo = 0 Then
    Err = 2
    ElseIf Not DataBaseFileTwo > 1 And DataBaseFileOne = 0 Then
    Err = 2
    End If
    If Err = 1 Then
        cmdOK.Enabled = False
        MsgBox "File does not exist!", 48
        Text1.SetFocus
    End If
    If Err = 2 Then
        cmdOK.Enabled = False
        MsgBox "This is an Invalid Database File!", 48
        Text1.SetFocus
    End If
    If Err = 0 Then
        cmdOK.Enabled = False
        NetworkDatabaseDemo.WindowState = 1 ' iconize form
        NetworkDatabaseDemo.Refresh
        'Build the chart
        Call DrawNetChart(DataBaseFile)
        Call ValidateFilename
    End If
End Sub
Private Sub DrawNetChart(DataBaseFile As String)

    Dim Shape As Object
    Dim Shape1 As Object
    Dim TextTitle As Object
    Dim recCount As Integer
    Dim PageWidth As Integer
    Dim ChartCancelled As Integer
    Dim CurrentRec As String
    Dim FieldInfo As String
    Dim ProcessorType As String
    Dim Chart As Object
    Dim ABCObject As Object
    Dim NewLine() As Object
    Dim Obj As Object
    Dim DataBaseText As Object
    Dim Counter As Integer
    Dim TotalCount As Integer
    'Get the chart
    Set Chart = ABC.New
    Rem Set the Chart's internal type
    Chart.Type = "NETWORK"
    Chart.TypeUsesEXE = True
    Set ABCObject = Chart.Objects
    'Prepare for chart to draw
    Chart.NoRepaint = True
    Chart.MasterItems.HideAll
    Chart.PageLayout.Orientation = 1
    Chart.View = 1
    ABC.ShapePaletteVisible = False
    ' Set defaults so there are no shape numbers
    Set Obj = Chart.DrawShape
    Obj.Shape.NumberShowN = False
    Chart.SetDefaults Obj
    Obj.Clear_               'This object can be seen when selected'
    'Set gauge
    ABC.PercentGauge NetworkDatabaseDemo.Caption, "Building Diagram", "Please Wait..."
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled = True Then
        Call EndAppDraw
        End If
    'Title page
    If FlowVersion >= 7.1 Then
        ABC.OpenPalette ("FlowCharter Palettes\Standard")
    End If
    Chart.CurrentShapePalette = "Standard"
    Chart.CurrentShape = "Rounded Process"
    Chart.DrawPositionX = 4.5
    Chart.DrawPositionY = 0.5
    Set Shape = Chart.DrawShape
    Shape.Height = 0.5
    Shape.Width = 5.5
    Shape.Text = "Network Diagram"
    Shape.Font.Size = 18
    Shape.Font.Bold = True
    Shape.Shape.BorderWidth = 3
    Shape.Shape.BorderColor = ABC.RED
    Shape.Shape.FillColor = ABC.GRAY
    'give feedback here
    'ABC.PercentGaugeValue = 10
    'cancel chart?
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If
   'Get Network palette
    If FlowVersion >= 7.1 Then
        ABC.OpenPalette ("FlowCharter Palettes\Net - PC Workstations")
    End If
    Chart.CurrentShapePalette = "Net - PC Workstations"
    Chart.CurrentShape = "Tower"
    'Set shape spacing
    Chart.DrawPositionX = 4.5
    Chart.DrawPositionY = 1.5
    Set Shape1 = Chart.DrawShape
    Shape1.Height = 1.25
    Shape1.Width = 1.25
    Shape1.Text = "SERVER"
    Shape1.Font.Bold = True
    Shape1.Font.Size = 12
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If
    'Open the Database
    Data1.DatabaseName = DataBaseFile
    Data1.RecordSource = "Network"
    Data1.Refresh
    'Get the number of records
    recCount = GetRecNum(Data1.Recordset)
    Data1.Refresh
    PageWidth = Chart.PageLayout.Width
    If recCount <= 5 Then
    Chart.DrawSpacingX = PageWidth / recCount
    Chart.DrawPositionX = (PageWidth / 2) / recCount
    Else
    Chart.DrawSpacingX = 1.5
    Chart.DrawPositionX = 1
    End If
    Chart.DrawPositionY = 3.5
    Chart.DrawDirection = 1
    Do While Not Data1.Recordset.EOF
        CurrentRec = GetCurrRec(Data1.Recordset)
        CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
        FieldInfo = Trim(NetSource.User)
        ProcessorType = Trim(NetSource.Computer)
    'Draw Shapes and add Usernames
        Chart.CurrentShape = ProcessorType
        Set Shape = Chart.DrawShape
        Shape.Height = 1.25
        Shape.Width = 1.25
        Shape.Text = FieldInfo
        Shape.Font.Size = 12
        Shape.Font.Color = ABC.BLUE
        TotalCount = recCount
        Counter = 100 / TotalCount
    'Draw Lines from server to workstation
        Chart.CurrentLineRouting = 3
            ReDim NewLine(recCount) As Object
        Set NewLine(recCount) = Chart.DrawLine(Shape1, Shape, 2, 0)
        NewLine(recCount).Line_.StemWidth = 3
        recCount = recCount - 1
    'Increment gauge
        If Counter > 0 Then
        ABC.PercentGaugeValue = Int(100 - (Counter * recCount))
        End If

     Data1.Recordset.MoveNext
    Loop
    'Give feedback here
    'ABC.PercentGaugeValue = 90
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If
    'Give double-click instructions
    Chart.DrawPositionX = 1.5
    Chart.DrawPositionY = 5
    Set TextTitle = Chart.DrawTextBlock(UCase("To find server information, Double-click on a shape."))
    TextTitle.Font.Bold = True
    TextTitle.Font.Size = 16
    TextTitle.CenterX = PageWidth / 2
    ' Write out database name
    Chart.DrawPositionX = 1.5
    Chart.DrawPositionY = 5.25
    Set DataBaseText = Chart.DrawTextBlock(LCase(Text1))
    DataBaseText.Font.Bold = False
    DataBaseText.Font.Size = 12
    DataBaseText.CenterX = PageWidth / 2
    'Data1.Recordset.Close
    Data1.Refresh
    'Give feedback here
    ABC.PercentGaugeValue = 99
    ABC.HidePercentGauge
    'Draw chart
    Chart.NoRepaint = False
    Chart.Repaint
End Sub
Private Sub EndAppDraw()
        ABC.HidePercentGauge
        End
End Sub
Private Sub Form_Load()
   'Open ABC
    Set ABC = CreateObject("ABCFlow.Application")
   ' ABC.Maximize
    ABC.Hourglass = True
    ABC.Visible = True
    FlowVersion = CDbl(ABC.Version)
    'Register the Events
    ABC.RegisterEvent ABC1, "Network", "DoubleClickSUBCLASS"
    ABC.RegisterEvent ABC1, "Network", "AppQuitNOTIFY"
    'Load both forms
    Load ServerInfo
    NetworkDatabaseDemo.Left = (Screen.Width - Width) \ 2
    NetworkDatabaseDemo.Top = (Screen.Height - Height) \ 2
    Text1.Text = UCase(App.Path & "\" & "netbase1.mdb")
    NetworkDatabaseDemo.Show
End Sub
Private Sub GetDatabaseInfo(UserName As String)
    Dim CurrentRec As String
    Data1.RecordSource = "Network"
    Data1.Refresh
    'Find this username in the database
        If UserName = Data1.Recordset.Fields("User").Value Then
            CurrentRec = GetCurrRec(Data1.Recordset)
            CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
    'Display server information
    ServerInfo.txtType.Text = Trim$(NetSource.Type)
    ServerInfo.txtProcess = Trim$(NetSource.Computer)
    ServerInfo.txtUserID = Trim$(NetSource.UserID)
    ServerInfo.txtUserName = Trim$(NetSource.User)
    ServerInfo.txtServer = Trim$(NetSource.Server)
    ServerInfo.Show 1

        ElseIf UserName = "" Then
                    MsgBox "This Station is Unassigned.", 64
        ElseIf Not UserName = Data1.Recordset.Fields("User").Value Then
            Data1.Recordset.MoveFirst
            Do
                Data1.Recordset.MoveNext
                    On Error GoTo Error_out
            Loop Until Data1.Recordset.EOF = True Or UserName = Data1.Recordset.Fields("User").Value
                CurrentRec = GetCurrRec(Data1.Recordset)
                CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
    'Display server information
    ServerInfo.txtType.Text = Trim$(NetSource.Type)
    ServerInfo.txtProcess = Trim$(NetSource.Computer)
    ServerInfo.txtUserID = Trim$(NetSource.UserID)
    ServerInfo.txtUserName = Trim$(NetSource.User)
    ServerInfo.txtServer = Trim$(NetSource.Server)
    ServerInfo.Show 1

        End If
Error_out:
          Select Case Err
                Case 3021
            ServerInfo.Hide
            MsgBox UCase("This is not a Workstation!") + Chr(13) + Chr(13) + "  Please choose a valid name."
            'DATA_ERRDISPLAY = 0
            'DATA_ERRCONTINUE = 1
            Data1.Refresh
            Data1.Recordset.MoveFirst
            Resume CloseDB
                Case Else
                Data1.Refresh
                ServerInfo.Hide
          End Select
CloseDB:
        Data1.Refresh
        Data1.Recordset.MoveFirst

End Sub
Private Sub Text1_Change()
    Call ValidateFilename
End Sub
Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub ValidateFilename()
    Dim Attr As Single
    On Error Resume Next
    Attr = GetAttr(Text1)
    If Err Then
        cmdOK.Enabled = False
    Else
        cmdOK.Enabled = True
    End If
End Sub