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