Concept-Blocks/src/s_ContextActions.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "s_ContextActions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ====== Test context shape actions ======
Option Explicit

Private page_ As Visio.Page

Public Function Setup()
  ' Mandatory setup function
  Set page_ = ThisDocument.Application.ActivePage
End Function

Public Function Teardown()
  ' Mandatory teardown function
  Call ClearAll
End Function

Public Function t_CycleElementType()
  On Error GoTo PROPAGATE_ERROR
  
  Dim iShape As Visio.Shape
  
  Call Dev_NewCase("Not element")
  Set iShape = page_.Drop(FindMaster(ThisDocument, MASTER_PROXY), 10, 10)
  On Error Resume Next
  Call CycleElementType(iShape)
  Call Dev_ExpectNoError
  On Error GoTo PROPAGATE_ERROR
  
  Call Dev_NewCase("Valid cycle")
  Set iShape = page_.Drop(FindMaster(ThisDocument, MASTER_ELEMENT), 0, 10)
  Call CellsSetValue(iShape, CELLSU_ELEMENT_TYPE, T_SE_BASIC)
  Call CycleElementType(iShape)
  Call Dev_ExpectEQ(T_SE_DERIVED, iShape.CellsU(CELLSU_ELEMENT_TYPE))
  Call CycleElementType(iShape)
  Call Dev_ExpectEQ(T_SE_ASSERTION, iShape.CellsU(CELLSU_ELEMENT_TYPE))
  Call CycleElementType(iShape)
  Call Dev_ExpectEQ(T_SE_COMMENT, iShape.CellsU(CELLSU_ELEMENT_TYPE))
  Call CycleElementType(iShape)
  Call Dev_ExpectEQ(T_SE_INTERPRETATION, iShape.CellsU(CELLSU_ELEMENT_TYPE))
  Call CycleElementType(iShape)
  Call Dev_ExpectEQ(T_SE_BASIC, iShape.CellsU(CELLSU_ELEMENT_TYPE))
  
  Exit Function
PROPAGATE_ERROR:
  Call Dev_LogError(Err.Number, Err.Description)
End Function

Public Function t_RenameSchemaDeep()
  On Error GoTo PROPAGATE_ERROR
  
  Dim iSchema As Visio.Shape: Set iSchema = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 0, 0)
  Dim iDuplicate As Visio.Shape: Set iDuplicate = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 10, 10)
  Dim iProxy As Visio.Shape: Set iProxy = page_.Drop(FindMaster(ThisDocument, MASTER_PROXY), 20, 20)
  iSchema.Text = "<22><>01 Test"
  iDuplicate.Text = "<22><>01 Test"
  iProxy.Text = "Test"
  
  Call RenameSchemaDeep(iSchema, "Test2")
  Call Dev_ExpectEQ("<22><>01 Test2", iSchema.Text, "Rename keep prefix")
  Call Dev_ExpectEQ("<22><>01 Test", iDuplicate.Text, "Do not rename duplicates")
  Call Dev_ExpectEQ("<22><>01 Test2", iProxy.Text, "Rename proxies")
  
  Exit Function
PROPAGATE_ERROR:
  Call Dev_LogError(Err.Number, Err.Description)
End Function

Public Function t_CreateProxyShape()
  On Error GoTo PROPAGATE_ERROR
  
  Dim iSchema As Visio.Shape: Set iSchema = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 0, 0)
  iSchema.Text = "Test"

  Dim iProxy As Visio.Shape: Set iProxy = CreateProxyShape(iSchema)
  Call Dev_AssertNotNothing(iProxy)
  Call Dev_ExpectEQ(SHAPE_PROXY, iProxy.MasterShape.Name, "Proxy master")
  Call Dev_ExpectEQ(iSchema.Text, iProxy.Text, "Proxy texxt")
  Call Dev_ExpectNE(iSchema.CellsU("PinX"), iProxy.CellsU("PinX"), "Proxy position")
  
  Exit Function
PROPAGATE_ERROR:
  Call Dev_LogError(Err.Number, Err.Description)
End Function

Public Function t_CreateOperationShape()
  On Error GoTo PROPAGATE_ERROR
  
  Call Dev_NewCase("No parents")
  Dim iSchema As Visio.Shape: Set iSchema = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 0, 0)
  Dim iOperation As Visio.Shape: Set iOperation = CreateOperationShape(iSchema)
  Call Dev_AssertNotNothing(iOperation)
  Call Dev_AssertEQ(3, page_.Shapes.Count, "Shapes count")
  Call Dev_ExpectEQ(SHAPE_OPERATION, iOperation.MasterShape.Name, "Operation master")
  Call Dev_ExpectAEQ(iOperation.CellsU("PinX"), iSchema.CellsU("PinX"), 1, "Operation position X")
  Call Dev_ExpectGR(iOperation.CellsU("PinY"), iSchema.CellsU("PinY"), "Operation position Y")
  Call Dev_ExpectTrue(VsoIsConnected(iOperation, iSchema), "Connection")
  Call ClearAll
  
  Call Dev_NewCase("Valid parents")
  Set iSchema = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 0, 0)
  Dim iParent1 As Visio.Shape: Set iParent1 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 10, 10)
  Dim iParent2 As Visio.Shape: Set iParent2 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), -10, 10)
  Dim iChild As Visio.Shape: Set iChild = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 0, -10)
  Call iParent1.AutoConnect(iSchema, visAutoConnectDirDown)
  Call iParent2.AutoConnect(iSchema, visAutoConnectDirDown)
  Call iSchema.AutoConnect(iChild, visAutoConnectDirDown)
  
  Set iOperation = CreateOperationShape(iSchema)
  Call Dev_AssertEQ(9, page_.Shapes.Count, "Shapes count")
  Call Dev_ExpectTrue(VsoIsConnected(iOperation, iSchema), "New Connection")
  Call Dev_ExpectTrue(VsoIsConnected(iParent1, iOperation), "Connection redirect1")
  Call Dev_ExpectTrue(VsoIsConnected(iParent2, iOperation), "Connection redirect2")
  Call Dev_ExpectTrue(VsoIsConnected(iSchema, iChild), "Do not redirect child")
  
  Exit Function
PROPAGATE_ERROR:
  Call Dev_LogError(Err.Number, Err.Description)
End Function

Public Function t_ShowHeader()
  On Error GoTo PROPAGATE_ERROR
  
  ThisDocument.DiagramServicesEnabled = visServiceStructureFull
  
  Dim iBlock As Visio.Shape: Set iBlock = page_.Drop(FindMaster(ThisDocument, MASTER_BLOCK), 0, 0)
  iBlock.Text = "Test"
  
  Call Dev_NewCase("Create valid header")
  Dim iHeader As Visio.Shape: Set iHeader = ShowHeader(iBlock, bShow:=True)
  Call Dev_AssertNotNothing(iHeader)
  Call Dev_ExpectEQ(iBlock.Text, iHeader.Text, "Header text")
  Call Dev_ExpectTrue(CellsGetValue(iBlock, CELLSU_BLOCK_HEADER), "Header flag")
  Call Dev_ExpectAEQ(iBlock.CellsU("PinX"), iHeader.CellsU("PinX"), 1, "Header position")
  
  Call Dev_NewCase("Remove header")
  Set iHeader = ShowHeader(iBlock, bShow:=False)
  Call Dev_AssertNothing(iHeader)
  Call Dev_ExpectEQ(1, page_.Shapes.Count, "Delete header")
  Call Dev_ExpectFalse(CellsGetValue(iBlock, CELLSU_BLOCK_HEADER), "Header flag")
  
  Call Dev_NewCase("Change header")
  Call ShowHeader(iBlock, bShow:=True)
  iBlock.Text = "Test2"
  Set iHeader = ShowHeader(iBlock, bShow:=True)
  Call Dev_AssertNotNothing(iHeader)
  Call Dev_ExpectEQ(2, page_.Shapes.Count, "Delete previous header")
  Call Dev_ExpectEQ(iBlock.Text, iHeader.Text, "Header text")
  Call Dev_ExpectTrue(CellsGetValue(iBlock, CELLSU_BLOCK_HEADER), "Header flag")
  Call Dev_ExpectAEQ(iBlock.CellsU("PinX"), iHeader.CellsU("PinX"), 1, "Header position")
  
  ThisDocument.DiagramServicesEnabled = 0
  
  Exit Function
PROPAGATE_ERROR:
  Call Dev_LogError(Err.Number, Err.Description)
End Function