133 lines
4.2 KiB
QBasic
133 lines
4.2 KiB
QBasic
Attribute VB_Name = "z_VsoGraph"
|
|
' ========= Extension functions for Visio ========
|
|
' Shared module version: 20210414
|
|
' Depends on: CDS_Graph
|
|
' Required reference: Scripting
|
|
Option Private Module
|
|
Option Explicit
|
|
|
|
Public Enum TConnectorDirection
|
|
T_CD_NONE = 0
|
|
T_CD_STRAIGHT = 1
|
|
T_CD_REVERSE = 2
|
|
T_CD_MUTUAL = 3
|
|
End Enum
|
|
|
|
Public Type ItemConnector
|
|
begin_ As Visio.Shape
|
|
end_ As Visio.Shape
|
|
dir_ As TConnectorDirection
|
|
End Type
|
|
|
|
Public Function ScanConnector(iArrow As Visio.Shape) As ItemConnector
|
|
ScanConnector.dir_ = GetConnectorDirection(iArrow)
|
|
If iArrow.Connects.Count = 2 Then
|
|
Set ScanConnector.begin_ = iArrow.Connects(1).ToSheet
|
|
Set ScanConnector.end_ = iArrow.Connects(2).ToSheet
|
|
ElseIf iArrow.Connects.Count = 1 Then
|
|
If iArrow.CellsU("BeginX").Formula Like "*GLUE*" Then
|
|
Set ScanConnector.begin_ = iArrow.Connects(1).ToSheet
|
|
Else
|
|
Set ScanConnector.end_ = iArrow.Connects(1).ToSheet
|
|
End If
|
|
End If
|
|
End Function
|
|
|
|
Public Function ScanGraph(ByRef iSeed As Collection, bReverseLinks As Boolean) As CDS_Graph
|
|
Dim iVisited As New Scripting.Dictionary
|
|
Dim iGraph As New CDS_Graph
|
|
Do While iSeed.Count > 0
|
|
Dim aShape As Visio.Shape: Set aShape = iSeed.Item(1)
|
|
Call iSeed.Remove(1)
|
|
If aShape.OneD Then _
|
|
GoTo NEXT_SHAPE
|
|
|
|
Dim nShape&: nShape = aShape.ID
|
|
If iVisited.Exists(nShape) Then _
|
|
GoTo NEXT_SHAPE
|
|
|
|
Call iVisited.Add(nShape, 0)
|
|
Call iGraph.AddNode(nShape)
|
|
Call ScanConnectorsFor(aShape, iSeed, iGraph, bReverseLinks)
|
|
|
|
NEXT_SHAPE:
|
|
Loop
|
|
Set ScanGraph = iGraph
|
|
End Function
|
|
|
|
Public Function VsoGetConnectedShape(vConnector As Visio.Shape, bBegin As Boolean) As Visio.Shape
|
|
Dim iConnector As ItemConnector: iConnector = ScanConnector(vConnector)
|
|
If bBegin Then
|
|
Set VsoGetConnectedShape = IIf(iConnector.dir_ <> T_CD_REVERSE, iConnector.begin_, iConnector.end_)
|
|
Else
|
|
Set VsoGetConnectedShape = IIf(iConnector.dir_ <> T_CD_REVERSE, iConnector.end_, iConnector.begin_)
|
|
End If
|
|
End Function
|
|
|
|
' =====
|
|
Private Function IsArrow(nEndType&) As Boolean
|
|
Select Case nEndType
|
|
Case 1 To 8: IsArrow = True
|
|
Case 12 To 19: IsArrow = True
|
|
Case 39 To 40: IsArrow = True
|
|
Case 43 To 45: IsArrow = True
|
|
Case Else: IsArrow = False
|
|
End Select
|
|
End Function
|
|
|
|
Private Function GetConnectorDirection(target As Visio.Shape) As TConnectorDirection
|
|
Dim bBegin As Boolean: bBegin = IsArrow(target.CellsU("BeginArrow"))
|
|
Dim bFinish As Boolean: bFinish = IsArrow(target.CellsU("EndArrow"))
|
|
|
|
If bBegin Then
|
|
GetConnectorDirection = IIf(bFinish, T_CD_MUTUAL, T_CD_REVERSE)
|
|
Else
|
|
GetConnectorDirection = IIf(bFinish, T_CD_STRAIGHT, T_CD_NONE)
|
|
End If
|
|
End Function
|
|
|
|
Private Function ScanConnectorsFor(target As Visio.Shape, ByRef iSeed As Collection, ByRef iGraph As CDS_Graph, bReverseLinks As Boolean)
|
|
Dim iConnect As Visio.Connect
|
|
For Each iConnect In target.FromConnects
|
|
If iConnect.FromSheet.Connects.Count <> 2 Then _
|
|
GoTo NEXT_CONNECT
|
|
|
|
Dim theInfo As ItemConnector: theInfo = ScanConnector(iConnect.FromSheet)
|
|
If bReverseLinks Then
|
|
If theInfo.dir_ = T_CD_STRAIGHT Then
|
|
theInfo.dir_ = T_CD_REVERSE
|
|
ElseIf theInfo.dir_ = T_CD_REVERSE Then
|
|
theInfo.dir_ = T_CD_STRAIGHT
|
|
End If
|
|
End If
|
|
|
|
If GraphAddEdge(iGraph, theInfo, theInfo.begin_ = target) Then
|
|
Dim destShape As Visio.Shape: Set destShape = IIf(theInfo.begin_ = target, theInfo.end_, theInfo.begin_)
|
|
Call iSeed.Add(destShape)
|
|
End If
|
|
NEXT_CONNECT:
|
|
Next iConnect
|
|
End Function
|
|
|
|
Private Function GraphAddEdge(ByRef graph As CDS_Graph, iConnector As ItemConnector, fixedBegin As Boolean) As Boolean
|
|
GraphAddEdge = False
|
|
Select Case iConnector.dir_
|
|
Case T_CD_MUTUAL, T_CD_NONE:
|
|
Call graph.AddEdge(iConnector.begin_.ID, iConnector.end_.ID)
|
|
Call graph.AddEdge(iConnector.end_.ID, iConnector.begin_.ID)
|
|
GraphAddEdge = True
|
|
|
|
Case T_CD_REVERSE:
|
|
If Not fixedBegin Then
|
|
Call graph.AddEdge(iConnector.end_.ID, iConnector.begin_.ID)
|
|
GraphAddEdge = True
|
|
End If
|
|
|
|
Case T_CD_STRAIGHT:
|
|
If fixedBegin Then
|
|
Call graph.AddEdge(iConnector.begin_.ID, iConnector.end_.ID)
|
|
GraphAddEdge = True
|
|
End If
|
|
End Select
|
|
End Function
|