PC World Komputer 1999 January/pcwk_01_1999.iso/Wtestowe/Vistdstd/Install/Data.Z/ProdView.CLS

Visual Basic class definition | 1997-06-26 | 10.3 KB | 278 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ProductView"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' -----------------------------------------------------------------------------
' Copyright (C) 1997 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.
' -----------------------------------------------------------------------------
Private tvcTree As TreeView
Private WithEvents theDocument As Visio.Document
Attribute theDocument.VB_VarHelpID = -1
Private WithEvents theApplication As Visio.Application
Attribute theApplication.VB_VarHelpID = -1
Private totalCost As Currency

Private Sub Class_Initialize()
' Event happens when an instance of this class module is created.

' Show the form and set its tree instance

    frmConfig.Show 0
    Set frmConfig.tvcProduct = Me
    Set tvcTree = frmConfig.TreeView1
End Sub

Public Sub PopulateTree()
'Read the drawing, excluding background pages, and add all shapes that have
'a custom property "Cost" to the tvcTree list.
    Dim i As Integer, j As Integer

    ' Populate with Existing Shapes

    For i = 1 To theDocument.Pages.Count
        If Not (theDocument.Pages(i).Background) Then
            For j = 1 To theDocument.Pages(i).Shapes.Count
                AddCostItem theDocument.Pages(i).Shapes(j)
            Next j
        End If
    Next i

End Sub

Public Sub SetStatus(str As String, arg1 As Variant)
'Set the contents of the status bar
    frmConfig.StatusBar1.Panels(1).Text = str & ":" & Format(arg1, "Currency")
    frmConfig.StatusBar1.Refresh

End Sub

Public Sub UnloadUI()
    ' close the form if it is open
   Unload frmConfig
End Sub

Public Sub InitWith(ByVal theDoc As Visio.Document)
'The starting point for this application
    Set theDocument = theDoc
    Set theApplication = theDoc.Application
    ' Parse the existing pages and add to the list
    Call PopulateTree
End Sub

Private Sub theApplication_AfterModal(ByVal app As Visio.IVApplication)
'Captures the changes to custom properties from the Visio custom properties
'dialog box. If the user changes a custom property the modal custom properties
'dialog box is displayed. When it is closed we treat that event the same as if
'the user clicked on the node in the tree (which refreshes its custom properties
'list.

    'SelectedItem will be nothing if we are modifying the properties of the page.
    If Not tvcTree.SelectedItem Is Nothing Then
        ClickedOnNode (tvcTree.SelectedItem.Text)
    End If
End Sub

Private Sub theApplication_SelectionChanged(ByVal Window As Visio.IVWindow)
    Dim shpObj As Visio.Shape
    On Error GoTo ErrorHandler

    If Window.Selection.Count = 1 Then
        'One item is selected - update the list
        Set shpObj = Window.Selection.Item(1)

        'NOTE: Does not work when new shape added because the selection changed
        'event occurs before the shape added event - thus the need for the error
        'handler. The shape added event will occur after and the shape's properties
        'will then be displayed.
        tvcTree.Nodes(shpObj.Name).Selected = True
        ShowListProperties
    Else
        'Either nothing is selected or more than one item is selected
        frmConfig.ListView1.ListItems.Clear
        Set frmConfig.TreeView1.SelectedItem = Nothing
    End If
    Exit Sub
ErrorHandler:
    frmConfig.ListView1.ListItems.Clear
    Set frmConfig.TreeView1.SelectedItem = Nothing
    Exit Sub
End Sub

Private Sub theDocument_BeforeDocumentClose(ByVal doc As Visio.IVDocument)
'The ConfigView application must be stopped if Visio is closed.
    Unload frmConfig
    End
End Sub

Private Sub theDocument_BeforeSelectionDelete(ByVal Selection As Visio.IVSelection)
'A shape, or shapes, is about to be deleted from the drawing.
'Delete each from the tvcTree.
    Dim i As Integer

    For i = 1 To Selection.Count
        DelCostItem Selection(i)
    Next i
End Sub

Private Sub theDocument_ShapeAdded(ByVal Shape As Visio.IVShape)
'A new shape has been added to the drawing. Check to see that it has
'a custom property "Cost" and if so add it to the list.
    AddCostItem Shape
End Sub

Public Sub ClickedOnNode(shpName As String)
'This procedure is called when the user selects an item from the tvcTree

    ' Select shape in Drawing.  The custom properties will be displayed as
    'a result of the selection changed event which will occur by setting the
    'Visio selection.
    SetVisioSelection (shpName)

End Sub

Public Sub AddCostItem(Shape As Visio.Shape)
'Add an item to the tvcTree only if it has the custom property "Cost"
'and the shape is visible in the drawing. Check the shape's layer
'property to determine if it currently visible.
    Dim tempNode As Node
    Dim Icon As String

    If Shape.CellExists("prop.cost", False) And IsVisible(Shape) Then
        Select Case Shape.Master.Name
            Case "Corner Desk": Icon = "Desk"
            Case "30"" Chest": Icon = "Dresser"
            Case "Dresser": Icon = "Dresser"
            Case "72"" Book Shelf": Icon = "Hutch"
            Case "35.5"" Door Chest": Icon = "DoorChest"
            Case "42"" Corner Hutch": Icon = "Hutch"
            Case "42"" Hutch": Icon = "Hutch"
            Case Else
                Icon = "Open"
        End Select
        Set tempNode = tvcTree.Nodes.Add(, , Shape.Name, Shape.Name, Icon)
        'Increment the total cost figure in the status bar
        totalCost = totalCost + CDbl(Shape.Cells("prop.cost").ResultStr(""))
        Me.SetStatus "Cost", totalCost
    End If
End Sub

Public Sub DelCostItem(Shape As Visio.Shape)
'Delete an item from the tvcTree and decriment the total cost figure in the status bar.
'If the Prop.Cost cell does not exist then the shape cannot be part of the list.
    If Shape.CellExists("prop.cost", False) Then
        totalCost = totalCost - CDbl(Shape.Cells("prop.cost").ResultStr(""))
        tvcTree.Nodes.Remove Shape.Name
        Me.SetStatus "Cost", totalCost
    End If
End Sub

Public Sub SetVisioSelection(shpName As String)
'Set the Visio drawing window to show shpName as the currently selected shape.

    'The error test is necessary since this routine is called following the
    'Application.After_Modal event. This event is triggered when Visio is
    'closed, and unsaved changes are in the drawing. Closing the modal
    'dialog leads to the calling of this routine.
    On Error Resume Next

    With theDocument.Application
        .ScreenUpdating = 0
        .ActiveWindow.Select .ActivePage.Shapes.Item(shpName), visSelect + visDeselectAll '2 + 256
        'Try zooming in on the drawing. This will center the current selection
        'if it is not already visible within the drawing window.
        .ActiveWindow.Zoom = .ActiveWindow.Zoom
        .ScreenUpdating = 1
    End With

End Sub

Public Sub ShowListProperties()
'List the custom properties of the selected shape
    Dim ssrcArray(1 To 5 * 4) As Integer
    Dim unitsArray(1 To 5) As Variant
    Dim resultLabels() As Variant
    Dim resultValues() As Variant
    Dim i As Integer
    Dim nrows As Integer

    'Clear any current custom properties display
    frmConfig.ListView1.ListItems.Clear

    'Get the first selected item. This routine should only be called
    'when there is exactly one selected item. See theApplication_SelectionChanged
    'event procedure.
    With theDocument.Application.ActiveWindow.Selection(1)
        nrows = .RowCount(visSectionProp)
        'Get the label properties for each row. For a detailed description
        'see the GetResults method in the Visio Automation Reference help file.
        For i = 0 To 4
            If i > nrows - 1 Then
                ssrcArray(i * 4 + 1) = visInvalShapeID
            Else
                ssrcArray(i * 4 + 1) = .ID
            End If
            ssrcArray(i * 4 + 2) = visSectionProp
            ssrcArray(i * 4 + 3) = visRowProp + i
            ssrcArray(i * 4 + 4) = visCustPropsLabel
        Next i
        theDocument.Application.ActivePage.GetResults ssrcArray, visGetStrings, unitsArray, resultLabels

        'Get the value properties for each row - only the cell property changes
        For i = 0 To nrows - 1
            ssrcArray(i * 4 + 4) = visCustPropsValue
            If resultLabels(i) = "Height" Then
                unitsArray(i + 1) = visInches
            Else
                unitsArray(i + 1) = visGetStrings
            End If
        Next i
        theDocument.Application.ActivePage.GetResults ssrcArray, visGetStrings, unitsArray, resultValues

        'Add the property label and its value to the listview control
        For i = 0 To nrows - 1
            Set li = frmConfig.ListView1.ListItems.Add(, , resultLabels(i))
            'The Select Case controls the formating of custom property values
            Select Case resultLabels(i)
              Case "Cost"
                li.SubItems(1) = Format(CDbl(resultValues(i)), "$0")
              Case "Height"
                li.SubItems(1) = Format(Val(resultValues(i)), "0.## in.")
              Case Else
                li.SubItems(1) = resultValues(i)
            End Select
        Next i

    End With
End Sub

Public Function IsVisible(Shape As Visio.Shape)
'Determine if a shape is visible by checking its layer properties
'to see that it is on a visible layer or on no layer at all
    Dim i As Integer
    Dim bVisible As Boolean

    'The shape is visible if it not in any layer. It is initialized to
    'false if it is a member of any layer.
    bVisible = (Shape.LayerCount = 0)

    For i = 1 To Shape.LayerCount
        'When any visible is layer is found, this is sufficient to exit
        If Shape.Layer(i).CellsC(visLayerVisible).Result(visNumber) <> 0 Then
            bVisible = True
            Exit For
        End If
    Next i

    IsVisible = bVisible
End Function