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 = "変01 Test" iDuplicate.Text = "変01 Test" iProxy.Text = "Test" Call RenameSchemaDeep(iSchema, "Test2") Call Dev_ExpectEQ("変01 Test2", iSchema.Text, "Rename keep prefix") Call Dev_ExpectEQ("変01 Test", iDuplicate.Text, "Do not rename duplicates") Call Dev_ExpectEQ("変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