Initial commit

VBAMake.txt

@@ -0,0 +1,43 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = Concept-Blocks
+name = Концепт-Блоки
+description = Технология визуализации отношений КС в различных формах
+artifact_home = Концепт-Блоки
+source_home = Concept-Blocks
+install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\01 Высокие технологии\Концепт-Блоки
+
+%%
+# === Build section ===
+# Available commands:
+#   build LOCAL_MANIFEST
+#   copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+#   save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+#   run LOCAL_SOURCE.bat
+
+build script\manifest.txt
+
+copy distr\!Руководство пользователя.docx
+copy distr\Шаблоны\Блоки-Excel.xltx -> Шаблоны\Блоки-Excel.xltx
+copy distr\Шаблоны\Блоки-Word.dotx -> Шаблоны\Блоки-Word.dotx
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+install Блоки.vstm
+
+install !Руководство пользователя.docx
+install Шаблоны\Блоки-Excel.xltx -> Шаблоны\Блоки-Excel.xltx
+install Шаблоны\Блоки-Word.dotx -> Шаблоны\Блоки-Word.dotx
+
+add_template Блоки.vstm -> 20 Концепт-Блоки.vstm
+add_template Шаблоны\Блоки-Excel.xltx -> Технологии\Блоки-Excel.xltx
+add_template Шаблоны\Блоки-Word.dotx -> Технологии\Блоки-Word.dotx

VERSION

@@ -0,0 +1 @@
+1.3.0

script/manifest.txt

@@ -0,0 +1,94 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = Блоки.vstm
+artifact = Блоки.vstm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+ui
+	CSE_ProgressBar.frm
+
+api
+	ex_WinAPI.bas
+	API_VsoWrapper.cls
+	API_XLWrapper.cls
+	API_WordWrapper.cls
+	API_UserInteraction.cls
+	
+utility
+	ex_VBA.bas
+	ex_Collection.bas
+	ex_Version.bas
+	
+	API_DistrManifest.cls
+	API_JSON.cls
+	API_LinkedComponents.cls
+	API_GraphOrdering.cls
+	CDS_Edge.cls
+	CDS_Factorizator.cls
+	CDS_Graph.cls
+	CDS_Node.cls
+
+visio
+	z_VsoUtilities.bas
+	z_CCVsoExtension.bas
+	z_VsoGraph.bas
+	API_UndoWrapper.cls
+	
+word
+	ex_Word.bas
+	
+dev
+	DevTester.bas
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	DevHelper.bas
+	Declarations.bas
+	DataAccess.bas
+	Main.bas
+	MainImpl.bas
+	z_UIRibbon.bas
+	z_UIMessages.bas
+
+	PowerEstimator.cls
+	WordExporter.cls
+	XLExporter.cls
+	
+	s_ContextActions.cls
+	s_Operations.cls
+	s_DataAccess.cls
+
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+.rels -> _rels\.rels
+customUI1.xml -> visio\customUI\customUI1.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Scripting
+global : Excel
+global : Word
+global : MSForms
+global : Shell32

src/DataAccess.bas

@@ -0,0 +1,173 @@
+Attribute VB_Name = "DataAccess"
+Option Private Module
+Option Explicit
+
+Public Function ExtractGraphNodes(target As Visio.Page) As Collection
+  Dim iNodes As New Collection
+  Dim aShape As Visio.Shape
+  For Each aShape In target.Shapes
+    If aShape.OneD Or aShape.MasterShape Is Nothing Then _
+      GoTo NEXT_SHAPE
+    Dim sMaster$: sMaster = aShape.MasterShape.Name
+    If sMaster = SHAPE_OPERATION _
+        Or sMaster = SHAPE_SCHEMA _
+        Or sMaster = SHAPE_PROXY Then _
+      Call iNodes.Add(aShape)
+NEXT_SHAPE:
+  Next aShape
+  Set ExtractGraphNodes = iNodes
+End Function
+
+Public Function ExtractSchemas(target As Visio.Page) As Collection
+  Dim iSchemas As New Collection
+  Dim aShape As Visio.Shape
+  For Each aShape In target.Shapes
+    If aShape.OneD Or aShape.MasterShape Is Nothing Then _
+      GoTo NEXT_SHAPE
+    Dim sMaster$: sMaster = aShape.MasterShape.Name
+    If sMaster = SHAPE_SCHEMA Then _
+      Call iSchemas.Add(aShape)
+NEXT_SHAPE:
+  Next aShape
+  Set ExtractSchemas = iSchemas
+End Function
+
+Public Function GetTemplate(sFile$, sLocalFolder$) As String
+  Dim fso As New Scripting.FileSystemObject
+  
+  GetTemplate = SERVER_TEMPLATES & "\" & sFile
+  If fso.FileExists(GetTemplate) Then _
+    Exit Function
+  
+  GetTemplate = sLocalFolder & "\" & sFile
+  If fso.FileExists(GetTemplate) Then _
+    Exit Function
+
+  GetTemplate = TEMPLATE_PREFIX & "\" & sFile
+End Function
+
+Public Function TrimEnumerator(sText$) As String
+  If IsNumerated(sText) Then
+    Dim pos&: pos = VBA.InStr(1, sText, " ")
+    TrimEnumerator = VBA.Right(sText, VBA.Len(sText) - pos)
+  Else
+    TrimEnumerator = sText
+  End If
+End Function
+
+Public Function ExtractEnumerator(sText$) As Long
+  If Not IsNumerated(sText) Then _
+    Exit Function
+  If sText Like "[?][?][?] *" Then _
+    Exit Function
+  Dim nPos&: nPos = VBA.InStr(1, sText, " ")
+  If VBA.Left(sText, 1) = "!" Then
+    ExtractEnumerator = CLng(VBA.Mid(sText, 4, nPos - 4))
+  Else
+    ExtractEnumerator = CLng(VBA.Mid(sText, 3, nPos - 3))
+  End If
+End Function
+
+Public Function AppendEnumerator(sText$, nIndex&) As String
+  AppendEnumerator = "ÊÑ" + Format(nIndex, "00") + " " + sText
+End Function
+
+Public Function IsElementary(shapeType As TElement) As Boolean
+  Select Case (shapeType)
+    Case T_EL_UNKNOWN: IsElementary = False
+    Case T_EL_SCHEMA: IsElementary = False
+    Case T_EL_PROXY: IsElementary = False
+    Case T_EL_BLOCK: IsElementary = False
+    Case T_EL_OPERATION: IsElementary = False
+    Case T_EL_HEADER: IsElementary = False
+    Case T_EL_MINIATURE: IsElementary = False
+    Case Else: IsElementary = True
+  End Select
+End Function
+
+Public Function GetShapeType(target As Visio.Shape) As TElement
+  If target.MasterShape Is Nothing Then
+    GetShapeType = T_EL_UNKNOWN
+    Exit Function
+  End If
+  
+  Select Case (target.MasterShape.Name)
+    Case SHAPE_SCHEMA: GetShapeType = T_EL_SCHEMA
+    Case SHAPE_PROXY: GetShapeType = T_EL_PROXY
+    Case SHAPE_BLOCK: GetShapeType = T_EL_BLOCK
+    Case SHAPE_OPERATION: GetShapeType = T_EL_OPERATION
+    Case SHAPE_IDENTIFICATION: GetShapeType = T_EL_IDENTITY
+    Case SHAPE_ELEMENT: GetShapeType = GetElementaryType(target)
+    Case SHAPE_HEADER: GetShapeType = T_EL_HEADER
+    Case SHAPE_MINIATURE: GetShapeType = T_EL_MINIATURE
+    Case Else: GetShapeType = T_EL_UNKNOWN
+  End Select
+End Function
+
+Public Function GetElementaryType(target As Visio.Shape) As TElement
+  If Not target.CellExistsU(CELLSU_ELEMENT_TYPE, visExistsAnywhere) Then
+    GetElementaryType = T_EL_COMMENT
+    Exit Function
+  End If
+  
+  Select Case (target.CellsU(CELLSU_ELEMENT_TYPE))
+    Case T_SE_BASIC: GetElementaryType = T_EL_BASIC
+    Case T_SE_DERIVED: GetElementaryType = T_EL_DERIVED
+    Case T_SE_ASSERTION: GetElementaryType = T_EL_ASSERTION
+    Case T_SE_COMMENT: GetElementaryType = T_EL_COMMENT
+    Case T_SE_INTERPRETATION: GetElementaryType = T_EL_INTERPRETATION
+    Case Else: GetElementaryType = T_EL_BASIC
+  End Select
+End Function
+
+Public Function ExtractPowerLevels(target As Visio.Page) As Scripting.Dictionary
+  Dim iGraph As CDS_Graph: Set iGraph = ScanGraph(ExtractGraphNodes(target), False)
+  Dim iOrder As Collection: Set iOrder = GeotopSort(target, iGraph)
+  Dim iReps As Scripting.Dictionary: Set iReps = ExtractRepresentatives(target)
+  Dim estimator As New PowerEstimator
+  Set ExtractPowerLevels = estimator.Estimate(iGraph, iOrder, iReps)
+End Function
+
+Public Function ExtractRepresentatives(target As Visio.Page) As Scripting.Dictionary
+  Dim iReps As New Scripting.Dictionary
+  
+  Dim schemas As Collection: Set schemas = ExtractGraphNodes(target)
+  Dim textReps As New Scripting.Dictionary
+  Dim aShape As Visio.Shape
+  Dim sText$
+  For Each aShape In schemas
+    If aShape.MasterShape.Name = SHAPE_SCHEMA Then
+      sText = TrimEnumerator(aShape.Text)
+      If Not textReps.Exists(sText) Then _
+        Call textReps.Add(sText, aShape.ID)
+    End If
+  Next aShape
+  
+  For Each aShape In schemas
+    If aShape.MasterShape.Name = SHAPE_PROXY Then
+      sText = TrimEnumerator(aShape.Text)
+      If textReps.Exists(sText) Then _
+        Call iReps.Add(aShape.ID, textReps(sText))
+    End If
+  Next aShape
+  
+  Set ExtractRepresentatives = iReps
+End Function
+
+' =========
+Private Function IsNumerated(sText$) As Boolean
+  IsNumerated = True
+  
+  If sText Like "ÊÑ#### *" Or sText Like "!ÊÑ#### *" Then _
+    Exit Function
+  If sText Like "ÊÑ### *" Or sText Like "!ÊÑ### *" Then _
+    Exit Function
+  If sText Like "ÊÑ## *" Or sText Like "!ÊÑ## *" Then _
+    Exit Function
+  If sText Like "ÊÑ# *" Or sText Like "!ÊÑ# *" Then _
+    Exit Function
+  If sText Like "[?][?][?] *" Then _
+    Exit Function
+  
+  IsNumerated = False
+End Function

src/Declarations.bas

@@ -0,0 +1,112 @@
+Attribute VB_Name = "Declarations"
+Option Private Module
+Option Explicit
+
+Public Const MASTER_BLOCK = "Áëîê"
+Public Const MASTER_ELEMENT = "Ýëåìåíò"
+Public Const MASTER_IDENTIFICATION = "Îòîæäåñòâëåíèå"
+Public Const MASTER_HEADER = "Çàãîëîâîê"
+Public Const MASTER_SCHEMA = "ÊÑ"
+Public Const MASTER_OPERATION = "Îïåðàöèÿ"
+Public Const MASTER_PROXY = "Äóáëåð"
+Public Const MASTER_MINIATURE = "Ìèíèàòþðà"
+
+Public Const SHAPE_BLOCK = "Blocks.Block"
+Public Const SHAPE_ELEMENT = "Blocks.Element"
+Public Const SHAPE_IDENTIFICATION = "Blocks.IdentityPair"
+Public Const SHAPE_HEADER = "Blocks.Header"
+Public Const SHAPE_SCHEMA = "Blocks.SchemaContainer"
+Public Const SHAPE_OPERATION = "Blocks.OperationContainer"
+Public Const SHAPE_PROXY = "Blocks.Proxy"
+Public Const SHAPE_MINIATURE = "Blocks.Summary"
+
+Public Const OPERATION_GAP = 30# / 25.4 ' mm to inches
+Public Const HEADER_MARGINS = 20# / 25.4
+Public Const HEADER_MAX_WIDTH = 1300 / 25.4
+Public Const MINIATURE_OFFSET = 5# / 25.4
+Public Const MINIATURE_HEIGHT_MULTIPLIER = 1.75
+
+Public Const CELLSU_CONTAINER_MARGINS = "User.msvSDContainerMargin"
+Public Const CELLSU_BLOCK_HEADER = "User.ShowHeader"
+Public Const CELLSU_ELEMENT_TYPE = "User.UType"
+Public Const CELLSU_IS_INHERITED = "User.IsInherited"
+Public Const CELLSU_IS_HIGHTLIGHT = "User.IsHighlight"
+
+Public Const TEMPLATE_PREFIX = "Òåõíîëîãèè"
+Public Const SERVER_TEMPLATES = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\Êîíöåïò-Áëîêè\Øàáëîíû"
+Public Const HELP_FILE_PATH = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\Êîíöåïò-Áëîêè\!Ðóêîâîäñòâî ïîëüçîâàòåëÿ.docx"
+
+' Type of schema element
+Public Enum TElement
+  T_EL_UNKNOWN = 0
+  [_First] = 1
+  
+  T_EL_BASIC = 1
+  T_EL_DERIVED = 2
+  T_EL_ASSERTION = 3
+  T_EL_COMMENT = 4
+  T_EL_INTERPRETATION = 5
+  
+  T_EL_SCHEMA = 6
+  T_EL_PROXY = 7
+  T_EL_BLOCK = 8
+  T_EL_OPERATION = 9
+  T_EL_IDENTITY = 10
+  
+  [_Last] = 10
+  T_EL_HEADER = 20
+  T_EL_MINIATURE = 21
+End Enum
+
+' Schema entity type
+Public Enum TSchemaEntity
+  T_SE_COMMENT = 0
+  T_SE_BASIC = 1
+  T_SE_DERIVED = 2
+  T_SE_INTERPRETATION = 3
+  T_SE_ASSERTION = 4
+End Enum
+
+' -------- Excel -------------
+Public Const XL_TEMPLATE_NAME = "Áëîêè-Excel.xltx"
+
+Public Const XL_SHEET_SHAPES = "Ôèãóðû"
+Public Const XL_SHEET_LINKS = "Ñâÿçè"
+
+Public Enum OutXLShapesStruct
+  [_First] = 1
+  
+  S_XLS_ID = 1
+  S_XLS_TYPE = 2
+  S_XLS_POWER = 3
+  S_XLS_TEXT1 = 4
+  S_XLS_TEXT2 = 5
+  S_XLS_CONTAINED = 6
+  S_XLS_INHERITED = 7
+  S_XLS_HIGHLIGHT = 8
+  S_XLS_PINX = 9
+  S_XLS_PINY = 10
+  S_XLS_WIDTH = 11
+  S_XLS_HEIGHT = 12
+
+  [_Last] = 12
+End Enum
+
+Public Enum OutXLLinksStruct
+  [_First] = 1
+  
+  S_XLL_ID = 1
+  S_XLL_SOURCE = 2
+  S_XLL_DESTINATION = 3
+  S_XLL_TEXT = 4
+
+  [_Last] = 4
+End Enum
+
+' -------- Word -------------
+Public Const WD_TEMPLATE_NAME = "Áëîêè-Word.dotx"
+
+Public Const WB_STYLE_TEXT = "!Àáçàö òåêñòà"
+Public Const WB_STYLE_SCHEMA = "Çàãîëîâîê 2"
+Public Const WB_STYLE_COMMENT = "!Àáçàö ðàçúÿñíåíèÿ"
+Public Const WB_STYLE_INTERPRETATION = "!Àáçàö ïðèìåðà"

src/DevHelper.bas

@@ -0,0 +1,24 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+  Call ClearAll
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_Operations"
+  Dim sTest$: sTest = "t_ToggleThemeColors"
+  Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest)
+  Debug.Print sMsg
+  Call MsgBox(sMsg)
+End Function
+
+Public Function Dev_GetTestSuite(sName$) As Object
+  Select Case sName
+    Case "s_DataAccess": Set Dev_GetTestSuite = New s_DataAccess
+    Case "s_ContextActions": Set Dev_GetTestSuite = New s_ContextActions
+    Case "s_Operations": Set Dev_GetTestSuite = New s_Operations
+  End Select
+End Function

src/Main.bas

@@ -0,0 +1,269 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Const PRODUCT_VERSION = "1.3.0"
+Public Const PRODUCT_NAME = "Concept-Blocks"
+
+Public g_VersionTimer As Long
+
+Public Sub StartVersionCheck()
+  g_VersionTimer = SetTimer(0, 0, CP_VERSION_MSG_DELAY, AddressOf OnVersionCheck)
+End Sub
+
+Public Function OnVersionCheck(ByVal nHwnd As Long, ByVal uMsg As Long, ByVal nEvent As Long, ByVal nTime As Long)
+  Call KillTimer(0, g_VersionTimer)
+  Call VersionValidate(PRODUCT_NAME, PRODUCT_VERSION)
+End Function
+
+Public Sub RunToggleHeaders()
+Attribute RunToggleHeaders.VB_ProcData.VB_Invoke_Func = "t"
+  Call GlobalUndo.BeginScope("Çàãîëîâêè")
+  ThisDocument.DiagramServicesEnabled = visServiceStructureFull
+  
+  Dim iSelected As Visio.Selection: Set iSelected = ActiveWindow.Selection
+  If iSelected.Count <> 0 Then
+    Call ToggleHeadersSelected(iSelected)
+  Else
+    Call ToggleHeadersAll(ActivePage)
+  End If
+  
+  ActiveWindow.Selection = iSelected
+  
+  ThisDocument.DiagramServicesEnabled = 0
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunWidthAdd10()
+Attribute RunWidthAdd10.VB_ProcData.VB_Invoke_Func = "e"
+  Call CC_WidthAdd10
+End Sub
+
+Public Sub RunWidthSub10()
+Attribute RunWidthSub10.VB_ProcData.VB_Invoke_Func = "q"
+  Call CC_WidthSub10
+End Sub
+
+Public Sub RunGotoLinkBegin()
+Attribute RunGotoLinkBegin.VB_ProcData.VB_Invoke_Func = "Q"
+  Call CC_GotoLinkBegin
+End Sub
+
+Public Sub RunGotoLinkEnd()
+Attribute RunGotoLinkEnd.VB_ProcData.VB_Invoke_Func = "E"
+  Call CC_GotoLinkEnd
+End Sub
+
+Public Sub RunToggleMiniatures()
+Attribute RunToggleMiniatures.VB_ProcData.VB_Invoke_Func = "T"
+  Call GlobalUndo.BeginScope("Îòîáðàæåíèå ìèíèàòþð")
+  
+  Call ToggleMiniatures(ActivePage)
+  Call ActiveWindow.DeselectAll
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunToggleHighlight()
+Attribute RunToggleHighlight.VB_ProcData.VB_Invoke_Func = "R"
+  Call GlobalUndo.BeginScope("Êëþ÷åâîé ñòàòóñ")
+  
+  Call ToggleHighlight(ActiveWindow.Selection)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunToggleInherited()
+  Call GlobalUndo.BeginScope("Ïðåîáðàçîâàíèå íàñëåäíèêîâ")
+  
+  Call ToggleInherited(ActiveWindow.Selection)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunCycleElementType()
+Attribute RunCycleElementType.VB_ProcData.VB_Invoke_Func = "r"
+  If ActiveWindow.Selection.Count = 0 Then
+    Call UserInteraction.ShowMessage(EM_SELECT_ELEMENT)
+    Exit Sub
+  End If
+  
+  Call GlobalUndo.BeginScope("Èçìåíåíèå òèïà ýëåìåíòà")
+  
+  Dim aShape As Visio.Shape
+  For Each aShape In ActiveWindow.Selection
+    Call CycleElementType(aShape)
+  Next aShape
+  
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunReflectParents()
+  If ActiveWindow.Selection.Count <> 1 Then
+    Call UserInteraction.ShowMessage(EM_SELECT_SCHEMA)
+    Exit Sub
+  End If
+  
+  Call GlobalUndo.BeginScope("Îòðàæåíèå")
+  ThisDocument.DiagramServicesEnabled = visServiceStructureBasic
+
+  Call ReflectParents(ActiveWindow.Selection(1))
+  
+  ThisDocument.DiagramServicesEnabled = 0
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunEnumerateSchemas()
+  Call GlobalUndo.BeginScope("Ïåðåíóìåðàöèÿ ñõåì")
+  Call EnumerateSchemasOn(ActivePage)
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunFixEnumeration()
+  Call GlobalUndo.BeginScope("Äîïèñûâàíèå íîìåðîâ")
+  Call FixEnumerationOn(ActivePage)
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunExportWord()
+  Dim iExporter As New WordExporter
+  If Not iExporter.Init(ThisDocument.Path) Then _
+    Exit Sub
+  
+  Dim iPage As Visio.Page: Set iPage = ActivePage
+  Dim iOrder As Collection: Set iOrder = GeotopSort(iPage, ScanGraph(ExtractGraphNodes(iPage), False))
+  
+  Call CSE_ProgressBar.Init("Âûãðóçêà äàííûõ", maxVal:=iOrder.Count)
+  Call CSE_ProgressBar.ShowModeless
+
+  Call iExporter.Export(iPage, iOrder)
+  
+  Call Unload(CSE_ProgressBar)
+  
+  Call UserInteraction.ShowMessage(IM_EXPORT_OK)
+End Sub
+
+Public Sub RunExportExcel()
+  Dim iExporter As New XLExporter
+  If Not iExporter.Init(ThisDocument.Path) Then _
+    Exit Sub
+  
+  Call CSE_ProgressBar.Init("Âûãðóçêà äàííûõ", maxVal:=ActivePage.Shapes.Count)
+  Call CSE_ProgressBar.ShowModeless
+  Call iExporter.Export(ActivePage)
+  Call Unload(CSE_ProgressBar)
+  
+  Call UserInteraction.ShowMessage(IM_EXPORT_OK)
+End Sub
+
+Public Sub RunToggleColorTheme()
+  Call GlobalUndo.BeginScope("Ñìåíà öâåòîâîé ïàëèòðû")
+  Call ToggleThemeColors(ActivePage)
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunHelp()
+  Dim wordWrap As New API_WordWrapper
+  Dim helpDoc As Word.Document: Set helpDoc = wordWrap.OpenDocument(HELP_FILE_PATH, bReadOnly:=True)
+  If helpDoc Is Nothing Then _
+    Exit Sub
+  With helpDoc
+    .ActiveWindow.View.ReadingLayout = False
+    Call .Application.Activate
+  End With
+End Sub
+
+' ===== Context menu API ========
+Public Function ToggleHeaderFor(target As Visio.Shape)
+  Call GlobalUndo.BeginScope("Çàãîëîâêè")
+  ThisDocument.DiagramServicesEnabled = visServiceStructureFull
+  
+  Dim iSelected As Visio.Selection: Set iSelected = ActiveWindow.Selection
+  Dim bShow As Boolean: bShow = CellsGetValue(target, CELLSU_BLOCK_HEADER)
+  Call ShowHeader(target, Not bShow)
+  ActiveWindow.Selection = iSelected
+  
+  ThisDocument.DiagramServicesEnabled = 0
+  Call GlobalUndo.EndScope
+End Function
+
+Public Function MinimizeListContainer(target As Visio.Shape)
+  If target.Shapes.Count <> 2 Then
+    Call UserInteraction.ShowMessage(EM_MINIMIZE_CONTAINERS_ONLY)
+    Exit Function
+  End If
+  
+  Call GlobalUndo.BeginScope("Ìèíèìèçàöèÿ")
+  
+  Call target.Resize(visResizeDirS, target.Shapes(2).CellsU("Height") - target.CellsU("Height"), visInches)
+
+  Call GlobalUndo.EndScope
+End Function
+
+Public Function FixElementsWidthFor(target As Visio.Shape)
+  ThisDocument.DiagramServicesEnabled = visServiceStructureBasic
+  
+  Dim itemWidth As Double: itemWidth = target.CellsU("Width") - 2 * target.CellsU(CELLSU_CONTAINER_MARGINS)
+  Dim memberID As Variant
+  Dim itemShape As Visio.Shape
+  For Each memberID In target.ContainerProperties.GetListMembers
+    Set itemShape = target.ContainingPage.Shapes.ItemFromID(memberID)
+    Call itemShape.Resize(visResizeDirE, itemWidth - itemShape.CellsU("Width"), visInches)
+  Next memberID
+  
+  ThisDocument.DiagramServicesEnabled = 0
+End Function
+
+Public Function FitToContentsFor(target As Visio.Shape)
+  Dim tmp&: tmp = target.ContainerProperties.ResizeAsNeeded
+  target.ContainerProperties.ResizeAsNeeded = visContainerAutoResizeExpandContract
+  DoEvents
+  target.ContainerProperties.ResizeAsNeeded = tmp
+End Function
+
+Public Function CreateProxyFor(target As Visio.Shape)
+  Call GlobalUndo.BeginScope("Ñîçäàíèå äóáëåðà")
+  ThisDocument.DiagramServicesEnabled = visServiceStructureFull
+
+  Dim iProxy As Visio.Shape: Set iProxy = CreateProxyShape(target)
+  Call ActiveWindow.Select(iProxy, visSelect)
+  
+  ThisDocument.DiagramServicesEnabled = 0
+  Call GlobalUndo.EndScope
+End Function
+
+Public Function CreateOperationFor(target As Visio.Shape)
+  If CountInboundConnects(target) < 1 Then
+    Call UserInteraction.ShowMessage(EM_OPERANDS_MISSING)
+    Exit Function
+  End If
+  
+  Call GlobalUndo.BeginScope("Ñîçäàíèå îïåðàöèè")
+  ThisDocument.DiagramServicesEnabled = visServiceStructureFull
+  
+  Dim iOperation As Visio.Shape: Set iOperation = CreateOperationShape(target)
+  Call ActiveWindow.Select(iOperation, visSelect)
+  
+  ThisDocument.DiagramServicesEnabled = 0
+  Call GlobalUndo.EndScope
+End Function
+
+Public Function RenameSchema(target As Visio.Shape)
+  Dim sInput$: sInput = UserInteraction.PromptInput("Ââåäèòå íîâîå íàçâàíèå ÊÑ", sInitial:=TrimEnumerator(target.Text))
+  If sInput = vbNullString Then _
+    Exit Function
+    
+  Call GlobalUndo.BeginScope("Ïåðåèìåíîâàíèå ÊÑ")
+  Call RenameSchemaDeep(target, sInput)
+  Call GlobalUndo.EndScope
+End Function
+
+' ==========
+Private Function CountInboundConnects(target As Visio.Shape) As Long
+  Dim nCount&
+  Dim iConnect As Visio.Connect
+  For Each iConnect In target.FromConnects
+    If target = iConnect.FromSheet.Connects(2).ToSheet Then _
+      nCount = nCount + 1
+  Next iConnect
+  CountInboundConnects = nCount
+End Function

src/MainImpl.bas

@@ -0,0 +1,376 @@
+Attribute VB_Name = "MainImpl"
+Option Private Module
+Option Explicit
+
+Public Function ClearAll()
+  Call VsoClearPage(ActivePage)
+End Function
+
+Public Function CycleElementType(target As Visio.Shape)
+  If Not target.CellExistsU(CELLSU_ELEMENT_TYPE, visExistsAnywhere) Then _
+    Exit Function
+    
+  Select Case (target.CellsU(CELLSU_ELEMENT_TYPE))
+    Case T_SE_BASIC: target.CellsU(CELLSU_ELEMENT_TYPE) = 2
+    Case T_SE_DERIVED: target.CellsU(CELLSU_ELEMENT_TYPE) = 4
+    Case T_SE_ASSERTION: target.CellsU(CELLSU_ELEMENT_TYPE) = 0
+    Case T_SE_COMMENT: target.CellsU(CELLSU_ELEMENT_TYPE) = 3
+    Case T_SE_INTERPRETATION: target.CellsU(CELLSU_ELEMENT_TYPE) = 1
+    Case Else: target.CellsU(CELLSU_ELEMENT_TYPE) = 1
+  End Select
+End Function
+
+Public Function ToggleInherited(targets As Visio.Selection)
+  Dim aShape As Visio.Shape
+  For Each aShape In targets
+    If aShape.CellExistsU(CELLSU_IS_INHERITED, visExistsAnywhere) Then _
+      aShape.CellsU(CELLSU_IS_INHERITED).FormulaU = IIf(aShape.CellsU(CELLSU_IS_INHERITED).Result(visLogical), "FALSE", "TRUE")
+  Next aShape
+End Function
+
+Public Function ToggleHighlight(targets As Visio.Selection)
+  Dim aShape As Visio.Shape
+  For Each aShape In targets
+    If aShape.CellExistsU(CELLSU_IS_HIGHTLIGHT, visExistsAnywhere) Then _
+      aShape.CellsU(CELLSU_IS_HIGHTLIGHT).FormulaU = IIf(aShape.CellsU(CELLSU_IS_HIGHTLIGHT).Result(visLogical), "FALSE", "TRUE")
+  Next aShape
+End Function
+
+Public Function ToggleMiniatures(target As Visio.Page)
+  If ClearMiniatures(target) = 0 Then _
+    Call CreateMiniatures(target)
+End Function
+
+Public Function EnumerateSchemasOn(target As Visio.Page)
+  Dim shapeOrder As Collection: Set shapeOrder = GeotopSort(target, ScanGraph(ExtractGraphNodes(target), False))
+  Dim indexBase As Scripting.Dictionary: Set indexBase = EnumerateSchemas(shapeOrder)
+  Call EnumerateProxies(shapeOrder, indexBase)
+End Function
+
+Public Function FixEnumerationOn(target As Visio.Page)
+  Dim shapeOrder As Collection: Set shapeOrder = GeotopSort(target, ScanGraph(ExtractGraphNodes(target), False))
+  Dim indexBase As New Scripting.Dictionary: Set indexBase = FixSchemas(target, shapeOrder)
+  Call EnumerateProxies(shapeOrder, indexBase)
+End Function
+
+Public Function ReflectParents(target As Visio.Shape)
+  Dim iGraph As CDS_Graph: Set iGraph = ScanGraph(CColl(target), True)
+  
+  Dim dBaseX As Double: dBaseX = target.CellsU("PinX")
+  
+  Dim nShapeID As Variant
+  Dim aShape As Visio.Shape
+  For Each nShapeID In iGraph.Nodes
+    Set aShape = target.Parent.Shapes.ItemFromID(nShapeID)
+    If aShape.MasterShape.Name = SHAPE_OPERATION Then _
+      Call SwapIdentifications(aShape)
+    aShape.CellsU("PinX") = dBaseX + (dBaseX - aShape.CellsU("PinX"))
+  Next nShapeID
+End Function
+
+Public Function ToggleThemeColors(iPage As Visio.Page)
+  Dim aShape As Visio.Shape
+  Dim bFirst As Boolean: bFirst = True
+  Dim bMakeLighter As Boolean
+  For Each aShape In iPage.Shapes
+    If aShape.MasterShape.Name <> SHAPE_ELEMENT Then _
+      GoTo NEXT_SHAPE
+    
+    If bFirst Then
+      bFirst = False
+      bMakeLighter = aShape.CellsU("User.Color1").FormulaU <> "RGB(233,244,226)"
+    End If
+    
+    Call ToggleElementColor(aShape, bMakeLighter)
+    
+NEXT_SHAPE:
+  Next aShape
+End Function
+
+Public Function CreateOperationShape(target As Visio.Shape) As Visio.Shape
+  Dim iOperation As Visio.Shape
+  With target
+    Set iOperation = .ContainingPage.Drop(FindMaster(.Document, MASTER_OPERATION), .CellsU("PinX"), .CellsU("PinY"))
+    iOperation.CellsU("PinY") = .CellsU("PinY") + .CellsU("Height") / 2# + iOperation.CellsU("Height") / 2# + OPERATION_GAP
+  End With
+  
+  Dim connection As Visio.Connect
+  For Each connection In target.FromConnects
+    If target = connection.FromSheet.Connects(2).ToSheet Then _
+      Call connection.FromSheet.CellsU("EndX").GlueTo(iOperation.CellsSRC(7, 1, 0))
+  Next connection
+  
+  Call iOperation.AutoConnect(target, visAutoConnectDirNone)
+  Set CreateOperationShape = iOperation
+End Function
+
+Public Function CreateProxyShape(target As Visio.Shape) As Visio.Shape
+  Dim newShape As Visio.Shape
+  With target
+    Set newShape = .ContainingPage.Drop(FindMaster(.Document, MASTER_PROXY), .CellsU("PinX"), .CellsU("PinY"))
+    newShape.Text = .Text
+    newShape.CellsU("PinX") = .CellsU("PinX") + .CellsU("Width") / 2# + newShape.CellsU("Width") / 2#
+  End With
+  Set CreateProxyShape = newShape
+End Function
+
+Public Function ToggleHeadersSelected(iSelected As Visio.Selection)
+  Dim aShape As Visio.Shape
+  Dim bShow As Boolean
+  For Each aShape In iSelected
+    If GetShapeType(aShape) <> T_EL_BLOCK Then _
+      GoTo NEXT_SHAPE
+
+    bShow = CellsGetValue(aShape, CELLSU_BLOCK_HEADER)
+    Call ShowHeader(aShape, Not bShow)
+    
+NEXT_SHAPE:
+  Next aShape
+End Function
+
+Public Function ToggleHeadersAll(iPage As Visio.Page)
+  Dim aShape As Visio.Shape
+  Dim bFirst As Boolean: bFirst = True
+  Dim bShow As Boolean
+  For Each aShape In iPage.Shapes
+    If GetShapeType(aShape) <> T_EL_BLOCK Then _
+      GoTo NEXT_SHAPE
+    
+    If bFirst Then
+      bFirst = False
+      bShow = CellsGetValue(aShape, CELLSU_BLOCK_HEADER)
+      bShow = Not bShow
+    End If
+    
+    Call ShowHeader(aShape, bShow)
+    
+NEXT_SHAPE:
+  Next aShape
+End Function
+
+Public Function ShowHeader(target As Visio.Shape, bShow As Boolean) As Visio.Shape
+  Call ResetHeader(target)
+  Call CellsSetValue(target, CELLSU_BLOCK_HEADER, bShow)
+  If bShow Then _
+    Set ShowHeader = CreateHeader(target)
+End Function
+
+Public Function GeotopSort(iPage As Visio.Page, iGraph As CDS_Graph) As Collection
+  If iGraph.Size = 0 Then
+    Set GeotopSort = New Collection
+    Exit Function
+  End If
+  
+  Dim ids() As Long: ids = ToLongArray(iGraph.Nodes)
+  Call VsoGeometricSort(ids, iPage)
+  
+  Dim iSorter As New API_GraphOrdering: Call iSorter.Init(iGraph)
+  Set GeotopSort = iSorter.SortLayers(FromArray(ids))
+End Function
+
+Public Function RenameSchemaDeep(target As Visio.Shape, sInput$)
+  Dim sPrefix$: sPrefix = target.Text
+  Dim sName$: sName = TrimEnumerator(target.Text)
+  If sName = sPrefix Then
+    sPrefix = vbNullString
+  Else
+    sPrefix = VBA.Left(sPrefix, VBA.Len(sPrefix) - VBA.Len(sName))
+  End If
+  
+  target.Text = sPrefix & sInput
+  Call RenameProxies(target.Parent, sPrefix, sName, sInput)
+End Function
+
+' ===========
+Private Function ResetHeader(target As Visio.Shape)
+  Dim memberID As Variant
+  Dim iPage As Visio.Page: Set iPage = target.ContainingPage
+  Dim itemShape As Visio.Shape
+  For Each memberID In target.ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
+    Set itemShape = iPage.Shapes.ItemFromID(memberID)
+    If GetShapeType(itemShape) = T_EL_HEADER Then
+      Call itemShape.Delete
+      Exit Function
+    End If
+  Next memberID
+End Function
+
+Private Function CreateHeader(target) As Visio.Shape
+  Dim newShape As Visio.Shape
+  With target
+    Set newShape = .ContainingPage.Drop(FindMaster(.Document, MASTER_HEADER), .CellsU("PinX"), .CellsU("PinY"))
+    newShape.CellsU("LockTextEdit") = 0
+    newShape.Text = .Text
+    newShape.CellsU("LockTextEdit") = 1
+    newShape.CellsU("Width") = IIf(HEADER_MAX_WIDTH > .CellsU("Width") - HEADER_MARGINS, .CellsU("Width") - HEADER_MARGINS, HEADER_MAX_WIDTH)
+  End With
+  Set CreateHeader = newShape
+End Function
+
+Private Function ClearMiniatures(target As Visio.Page) As Long
+  Dim cDelete As New Collection
+  Dim iShape As Visio.Shape
+  For Each iShape In target.Shapes
+    If GetShapeType(iShape) = T_EL_MINIATURE Then _
+      Call cDelete.Add(iShape)
+  Next iShape
+  
+  For Each iShape In cDelete
+    Call iShape.Delete
+  Next iShape
+  
+  ClearMiniatures = cDelete.Count
+End Function
+
+Private Function CreateMiniatures(target As Visio.Page)
+  Dim sText$
+  Dim dHeight As Double
+  Dim iMiniature As Visio.Shape
+  Dim iSchema As Visio.Shape
+  For Each iSchema In ExtractSchemas(target)
+    Set iMiniature = target.Drop(FindMaster(iSchema.Document, MASTER_MINIATURE), iSchema.CellsU("PinX"), iSchema.CellsU("PinY"))
+    iMiniature.CellsU("Width") = iSchema.CellsU("Width") + 2 * MINIATURE_OFFSET
+    iMiniature.Shapes(2).Text = iSchema.Text
+    
+    dHeight = 0
+    sText = ""
+    
+    Dim nElement As Variant
+    Dim iElement As Visio.Shape
+    Dim elems As Variant: elems = iSchema.ContainerProperties.GetListMembers
+    For Each nElement In elems
+      Set iElement = target.Shapes.ItemFromID(nElement)
+      If CellsGetValue(iElement, CELLSU_IS_HIGHTLIGHT) Then
+        dHeight = dHeight + iElement.CellsU("Height")
+        If sText = vbNullString Then
+          sText = iElement.Text
+        Else
+          sText = sText & vbNewLine & iElement.Text
+        End If
+      End If
+    Next nElement
+    
+    iMiniature.Shapes(1).Text = sText
+    iMiniature.CellsU("Height") = iMiniature.Shapes(2).CellsU("Height") + dHeight * MINIATURE_HEIGHT_MULTIPLIER
+    iMiniature.CellsU("PinY") = iSchema.CellsU("PinY") + iSchema.CellsU("Height") / 2# - iMiniature.CellsU("Height") / 2# + MINIATURE_OFFSET
+    
+  Next iSchema
+End Function
+
+Private Function SwapIdentifications(target As Visio.Shape)
+  Dim memberID As Variant
+  Dim member As Visio.Shape
+  For Each memberID In target.ContainerProperties.GetListMembers
+    Set member = target.ContainingPage.Shapes.ItemFromID(memberID)
+    If member.MasterShape.Name = SHAPE_IDENTIFICATION Then
+      Dim sText$: sText = member.Shapes(1).Text
+      member.Shapes(1).Text = member.Shapes(2).Text
+      member.Shapes(2).Text = sText
+    End If
+  Next memberID
+End Function
+
+Private Function EnumerateSchemas(shapeOrder As Collection) As Scripting.Dictionary
+  Dim indexBase As New Scripting.Dictionary
+  Dim nNext&: nNext = 1
+  Dim shapeID As Variant
+  Dim aShape As Visio.Shape
+  For Each shapeID In shapeOrder
+    Set aShape = ActivePage.Shapes.ItemFromID(shapeID)
+    If aShape.MasterShape.Name = SHAPE_SCHEMA Then
+      Dim sText$: sText = TrimEnumerator(aShape.Text)
+      If Not indexBase.Exists(sText) Then
+        Call indexBase.Add(sText, nNext)
+        nNext = nNext + 1
+        aShape.Text = AppendEnumerator(sText, indexBase(sText))
+      Else
+        aShape.Text = "!" + AppendEnumerator(sText, indexBase(sText))
+      End If
+    End If
+  Next shapeID
+  Set EnumerateSchemas = indexBase
+End Function
+
+Private Function EnumerateProxies(iOrder As Collection, indexBase As Scripting.Dictionary)
+  Dim shapeID As Variant
+  Dim aShape As Visio.Shape
+  For Each shapeID In iOrder
+    Set aShape = ActivePage.Shapes.ItemFromID(shapeID)
+    If aShape.MasterShape.Name = SHAPE_PROXY Then
+      Dim sText$: sText = TrimEnumerator(aShape.Text)
+      If Not indexBase.Exists(sText) Then
+        aShape.Text = "??? " + sText
+      Else
+        aShape.Text = AppendEnumerator(sText, indexBase(sText))
+      End If
+    End If
+  Next shapeID
+End Function
+
+Private Function FixSchemas(iPage As Visio.Page, iOrder As Collection) As Scripting.Dictionary
+  Dim indexBase As New Scripting.Dictionary
+  Dim nMaxIndex&: nMaxIndex = 0
+ 
+  Dim sText$
+  Dim aShape As Visio.Shape
+  Dim shapeID As Variant
+  For Each shapeID In iOrder
+    Set aShape = iPage.Shapes.ItemFromID(shapeID)
+    If aShape.MasterShape.Name <> SHAPE_SCHEMA Then _
+      GoTo NEXT_SHAPE
+    
+    Dim enumerator&: enumerator = ExtractEnumerator(aShape.Text)
+    If enumerator = 0 Then _
+      GoTo NEXT_SHAPE
+    If enumerator > nMaxIndex Then _
+      nMaxIndex = enumerator
+    
+    sText = TrimEnumerator(aShape.Text)
+    If Not indexBase.Exists(sText) Then
+      Call indexBase.Add(sText, enumerator)
+    Else
+      aShape.Text = "!" + AppendEnumerator(sText, enumerator)
+    End If
+NEXT_SHAPE:
+  Next shapeID
+  
+  Dim nextIndex&: nextIndex = nMaxIndex + 1
+  For Each shapeID In iOrder
+    Set aShape = iPage.Shapes.ItemFromID(shapeID)
+    If aShape.MasterShape.Name = SHAPE_SCHEMA Then
+      sText = TrimEnumerator(aShape.Text)
+      If Not indexBase.Exists(sText) Then
+        Call indexBase.Add(sText, nextIndex)
+        nextIndex = nextIndex + 1
+        aShape.Text = AppendEnumerator(sText, indexBase(sText))
+      End If
+    End If
+  Next shapeID
+  
+  Set FixSchemas = indexBase
+End Function
+
+Private Function RenameProxies(iPage As Visio.Page, sPrefix$, sOldName$, sNewName$)
+  Dim aShape As Visio.Shape
+  For Each aShape In iPage.Shapes
+    If aShape.MasterShape.Name = SHAPE_PROXY Then _
+      If TrimEnumerator(aShape.Text) = sOldName Then _
+        aShape.Text = sPrefix & sNewName
+  Next aShape
+End Function
+
+Private Function ToggleElementColor(target As Visio.Shape, bMakeLighter As Boolean)
+  With target
+    If bMakeLighter Then
+      .CellsU("User.Color1").FormulaU = "RGB(233,244,226)"
+      .CellsU("User.Color2").FormulaU = "RGB(213,241,255)"
+      .CellsU("User.Color3").FormulaU = "RGB(238,227,240)"
+      .CellsU("User.Color4").FormulaU = "RGB(255,216,213)"
+    Else
+      .CellsU("User.Color1").FormulaU = "="
+      .CellsU("User.Color2").FormulaU = "="
+      .CellsU("User.Color3").FormulaU = "="
+      .CellsU("User.Color4").FormulaU = "="
+    End If
+  End With
+End Function

src/PowerEstimator.cls

@@ -0,0 +1,71 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "PowerEstimator"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ====== Estimate power level according to graph synthesis ====
+Option Explicit
+
+Private graph_ As CDS_Graph
+Private powerLevels_ As Scripting.Dictionary
+Private visiting_ As Scripting.Dictionary
+Private reps_ As Scripting.Dictionary
+
+Public Function Estimate(iGraph As CDS_Graph, iOrder As Collection, iReps As Scripting.Dictionary) As Scripting.Dictionary
+  Set graph_ = iGraph
+  Set reps_ = iReps
+  Call Reset
+  
+  Dim vNode As Variant
+  For Each vNode In iOrder
+    Call GetPowerRecursive(vNode)
+  Next vNode
+
+  Set Estimate = powerLevels_
+End Function
+
+' ===========
+Private Function Reset()
+  Set powerLevels_ = New Scripting.Dictionary
+  Set visiting_ = New Scripting.Dictionary
+  Set reps_ = New Scripting.Dictionary
+End Function
+
+Private Function GetPowerRecursive(vNode As Variant) As Long
+  If reps_.Exists(vNode) Then _
+    vNode = reps_(vNode)
+    
+  If visiting_.Exists(vNode) Then
+    Call MsgBox("Âíèìàíèå! Ãðàô ñèíòåçà ñîäåðæèò öèêë!", vbExclamation) ' TODO: extract message and raise error instead
+    GetPowerRecursive = 0
+    Exit Function
+  End If
+    
+  If powerLevels_.Exists(vNode) Then
+    GetPowerRecursive = powerLevels_(vNode)
+    Exit Function
+  End If
+  
+  Call visiting_.Add(vNode, 0)
+   
+  Dim parentCount&: parentCount = graph_.nodes_(vNode).inputs_.Count
+  Dim nLevel&
+  If parentCount = 0 Then
+    nLevel = 1
+  Else
+    nLevel = 0
+    Dim vChild As Variant
+    For Each vChild In graph_.nodes_(vNode).inputs_
+      nLevel = nLevel + GetPowerRecursive(vChild)
+    Next vChild
+  End If
+  
+  Call visiting_.Remove(vNode)
+  
+  Call powerLevels_.Add(vNode, nLevel)
+  GetPowerRecursive = nLevel
+End Function

src/ThisDocument.cls

@@ -0,0 +1,22 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ThisDocument"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private Sub Document_DocumentOpened(ByVal iDoc As IVDocument)
+  If iDoc.ID <> ThisDocument.ID Then _
+    Exit Sub
+  
+  Dim sCmd$: sCmd = OfficeCommandLine
+  If VBA.InStr(1, sCmd, "/automation", vbTextCompare) <> 0 Then _
+    Exit Sub
+  
+  Call StartVersionCheck
+End Sub
+

src/WordExporter.cls

@@ -0,0 +1,82 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "WordExporter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private app_ As API_WordWrapper
+Private out_ As Word.Document
+Private source_ As Visio.Page
+
+Public Function Init(sLocalTemplates$) As Boolean
+  Init = False
+  
+  Set app_ = New API_WordWrapper
+  Dim sTemplate$: sTemplate = GetTemplate(WD_TEMPLATE_NAME, sLocalTemplates)
+  If sTemplate = vbNullString Then
+    Call UserInteraction.ShowMessage(EM_WORD_MISSING_TEMPLATE)
+    Exit Function
+  End If
+  Set out_ = app_.NewDocument(sTemplate)
+  If out_ Is Nothing Then _
+    Exit Function
+  
+  Init = True
+End Function
+
+Public Function Export(iSource As Visio.Page, iOrder As Collection)
+  Set source_ = iSource
+  Call app_.PauseUI
+
+  Dim shapeID As Variant
+  Dim aShape As Visio.Shape
+  For Each shapeID In iOrder
+    Set aShape = source_.Shapes.ItemFromID(CLng(shapeID))
+    If aShape.MasterShape.Name = SHAPE_SCHEMA Then _
+      Call ExportSchema(aShape)
+    Call CSE_ProgressBar.IncrementA
+  Next shapeID
+  Call out_.TablesOfContents(1).Update
+  
+  Call app_.ResumeUI
+End Function
+
+' ========
+Private Function ExportSchema(target As Visio.Shape)
+  Dim textPos As Word.Range
+  Set textPos = WordAddLine(VBA.Trim(target.Text), out_.Content, WB_STYLE_SCHEMA)
+  
+  Dim nCount&: nCount = UBound(target.ContainerProperties.GetListMembers) + 1
+  If nCount = 0 Then _
+    Exit Function
+    
+  Dim memberID As Variant
+  Dim bFirst As Boolean: bFirst = True
+  Dim aShape As Visio.Shape
+  For Each memberID In target.ContainerProperties.GetListMembers
+    Set aShape = source_.Shapes.ItemFromID(memberID)
+    Set textPos = WordAddLine(VBA.Trim(aShape.Text), textPos, ElementStyle(aShape))
+    If Not bFirst Then _
+      Set textPos = WordAddLine(vbNullString, textPos, WB_STYLE_TEXT)
+    bFirst = False
+  Next memberID
+End Function
+
+Private Function ElementStyle(target As Visio.Shape) As String
+  If Not target.CellExistsU(CELLSU_ELEMENT_TYPE, visExistsAnywhere) Then _
+    ElementStyle = WB_STYLE_TEXT
+  
+  Select Case (target.CellsU(CELLSU_ELEMENT_TYPE))
+    Case T_SE_BASIC: ElementStyle = WB_STYLE_TEXT
+    Case T_SE_DERIVED: ElementStyle = WB_STYLE_TEXT
+    Case T_SE_ASSERTION: ElementStyle = WB_STYLE_TEXT
+    Case T_SE_COMMENT: ElementStyle = WB_STYLE_COMMENT
+    Case T_SE_INTERPRETATION: ElementStyle = WB_STYLE_INTERPRETATION
+    Case Else: ElementStyle = WB_STYLE_TEXT
+  End Select
+End Function

src/XLExporter.cls

@@ -0,0 +1,106 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "XLExporter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private app_ As API_XLWrapper
+Private outLinks_ As Excel.Worksheet
+Private outShapes_ As Excel.Worksheet
+
+Private powers_ As Scripting.Dictionary
+Private nLink_ As Long
+Private nShape_ As Long
+
+Public Function Init(sLocalTemplates$) As Boolean
+  Set app_ = New API_XLWrapper
+  Dim sTemplate$: sTemplate = GetTemplate(XL_TEMPLATE_NAME, sLocalTemplates)
+  Init = Not app_.NewDocument(sTemplate, bDefaultIfFail:=True) Is Nothing
+  If Not Init Then _
+    Exit Function
+  If sTemplate = vbNullString Then _
+    Call PrepareDefaultOutput
+  Set outLinks_ = app_.Document.Sheets(XL_SHEET_LINKS)
+  Set outShapes_ = app_.Document.Sheets(XL_SHEET_SHAPES)
+End Function
+
+Public Function Export(iSource As Visio.Page)
+  Call app_.PauseUI
+  
+  Set powers_ = ExtractPowerLevels(iSource)
+  nLink_ = 2
+  nShape_ = 2
+  Dim aShape As Visio.Shape
+  For Each aShape In iSource.Shapes
+    If aShape.OneD Then
+      If aShape.Connects.Count = 2 Then
+        Call ExportLink(aShape)
+      End If
+    Else
+      Call ExportShape(aShape)
+    End If
+    Call CSE_ProgressBar.IncrementA
+  Next aShape
+  
+  Call app_.ResumeUI
+End Function
+
+' ==========
+Private Function PrepareDefaultOutput()
+  Call UserInteraction.ShowMessage(EM_MISSING_TEMPLATE)
+  With app_.Document
+    .Sheets.Add
+    .Sheets(1).Name = XL_SHEET_SHAPES
+    .Sheets(2).Name = XL_SHEET_LINKS
+  End With
+End Function
+
+Private Function ExportLink(target As Visio.Shape)
+  outLinks_.Cells(nLink_, S_XLL_ID) = target.ID
+  outLinks_.Cells(nLink_, S_XLL_SOURCE) = target.Connects(1).ToSheet.ID
+  outLinks_.Cells(nLink_, S_XLL_DESTINATION) = target.Connects(2).ToSheet.ID
+  outLinks_.Cells(nLink_, S_XLL_TEXT) = target.Text
+  nLink_ = nLink_ + 1
+End Function
+
+Private Function ExportShape(target As Visio.Shape) As Boolean
+  Dim nType As TElement: nType = GetShapeType(target)
+  If nType = T_EL_HEADER Or nType = T_EL_MINIATURE Then _
+    Exit Function
+  
+  Dim bInherited As Boolean: bInherited = CellsGetValue(target, CELLSU_IS_INHERITED)
+  Dim bHighlighted As Boolean: bHighlighted = CellsGetValue(target, CELLSU_IS_HIGHTLIGHT)
+  Dim vParent As Visio.Shape: Set vParent = GetContainingShape(target)
+  
+  outShapes_.Cells(nShape_, S_XLS_ID) = target.ID
+  outShapes_.Cells(nShape_, S_XLS_TYPE) = nType
+  If powers_.Exists(target.ID) And nType = T_EL_SCHEMA Then _
+    outShapes_.Cells(nShape_, S_XLS_POWER) = powers_(target.ID)
+  
+  If IsElementary(nType) Then
+    outShapes_.Cells(nShape_, S_XLS_INHERITED) = IIf(bInherited, "äà", "íåò")
+    outShapes_.Cells(nShape_, S_XLS_HIGHLIGHT) = IIf(bHighlighted, "äà", "íåò")
+  End If
+  
+  outShapes_.Cells(nShape_, S_XLS_PINX) = target.CellsU("PinX").Result(visMillimeters)
+  outShapes_.Cells(nShape_, S_XLS_PINY) = target.CellsU("PinY").Result(visMillimeters)
+  outShapes_.Cells(nShape_, S_XLS_WIDTH) = target.CellsU("Width").Result(visMillimeters)
+  outShapes_.Cells(nShape_, S_XLS_HEIGHT) = target.CellsU("Height").Result(visMillimeters)
+  
+  If Not vParent Is Nothing Then _
+    outShapes_.Cells(nShape_, S_XLS_CONTAINED) = vParent.ID
+  
+  If nType <> T_EL_IDENTITY Then
+    outShapes_.Cells(nShape_, S_XLS_TEXT1) = target.Text
+  Else
+    outShapes_.Cells(nShape_, S_XLS_TEXT1) = target.Shapes(1).Text
+    outShapes_.Cells(nShape_, S_XLS_TEXT2) = target.Shapes(2).Text
+  End If
+  
+  nShape_ = nShape_ + 1
+End Function

src/s_ContextActions.cls

@@ -0,0 +1,164 @@
+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

src/s_DataAccess.cls

@@ -0,0 +1,155 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_DataAccess"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+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_Enumerator()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Empty string")
+  Call Dev_ExpectEQ("", TrimEnumerator(""))
+  Call Dev_ExpectEQ(0, ExtractEnumerator(""))
+  
+  Call Dev_NewCase("Invalid enumerated")
+  Call Dev_ExpectEQ("1.1 Test", TrimEnumerator("1.1 Test"))
+  Call Dev_ExpectEQ(0, ExtractEnumerator("1.1 Test"))
+  Call Dev_ExpectEQ("1.1. Test", TrimEnumerator("1.1. Test"))
+  Call Dev_ExpectEQ(0, ExtractEnumerator("1.1. Test"))
+  
+  Call Dev_NewCase("Valid enumerated")
+  Call Dev_ExpectEQ("Test1", TrimEnumerator("ÊÑ1 Test1"))
+  Call Dev_ExpectEQ(1, ExtractEnumerator("ÊÑ1 Test1"))
+  Call Dev_ExpectEQ("Test2", TrimEnumerator("!ÊÑ2 Test2"))
+  Call Dev_ExpectEQ(2, ExtractEnumerator("!ÊÑ2 Test2"))
+  Call Dev_ExpectEQ("Test3", TrimEnumerator("??? Test3"))
+  Call Dev_ExpectEQ(0, ExtractEnumerator("??? Test3"))
+  
+  Call Dev_NewCase("Extract appended")
+  Dim sText$: sText = AppendEnumerator("Test", 1337)
+  Call Dev_ExpectEQ("Test", TrimEnumerator(sText))
+  Call Dev_ExpectEQ(1337, ExtractEnumerator(sText))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ExtractGraphNodes()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectEQ(0, ExtractGraphNodes(page_).Count, "Empty page")
+  
+  Call Dev_NewCase("Invalid shapes")
+  Call page_.DrawLine(0, 0, 1, 1)
+  Call page_.DrawRectangle(2, 2, 3, 3)
+  Call page_.Drop(FindMaster(ThisDocument, MASTER_ELEMENT), 10, 10)
+  Call page_.Drop(FindMaster(ThisDocument, MASTER_IDENTIFICATION), 15, 15)
+  Call Dev_ExpectEQ(0, ExtractGraphNodes(page_).Count)
+  
+  Call Dev_NewCase("Valid schemas")
+  Dim ks1 As Visio.Shape: Set ks1 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 20, 20)
+  ks1.Text = "Test1"
+  Dim ks2 As Visio.Shape: Set ks2 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 25, 25)
+  ks2.Text = "Test2"
+  Dim iOperation As Visio.Shape: Set iOperation = page_.Drop(FindMaster(ThisDocument, MASTER_OPERATION), 30, 30)
+  Dim iProxy As Visio.Shape: Set iProxy = page_.Drop(FindMaster(ThisDocument, MASTER_PROXY), 35, 35)
+  iProxy.Text = ks1.Text
+  Dim iBlock As Visio.Shape: Set iBlock = page_.Drop(FindMaster(ThisDocument, MASTER_BLOCK), 40, 40)
+  Dim iNodes As Collection: Set iNodes = CColl(ks1, ks2, iOperation, iProxy)
+  Call Dev_ExpectEQ(iNodes, ExtractGraphNodes(page_))
+    
+  Call Dev_NewCase("Contained shapes")
+  Call iBlock.ContainerProperties.AddMember(ks2, visMemberAddExpandContainer)
+  Call Dev_ExpectEQ(iNodes, ExtractGraphNodes(page_))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ExtractRepresentatives()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectEQ(0, ExtractRepresentatives(page_).Count, "Empty page")
+  
+  Call Dev_NewCase("Literal representatives")
+  Dim iSchema As Visio.Shape: Set iSchema = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 20, 20)
+  iSchema.Text = "Test"
+  Dim iProxy As Visio.Shape: Set iProxy = page_.Drop(FindMaster(ThisDocument, MASTER_PROXY), 35, 35)
+  iProxy.Text = "Test"
+  Dim iReps As New Scripting.Dictionary
+  iReps(iProxy.ID) = iSchema.ID
+  Call Dev_ExpectEQ(iReps, ExtractRepresentatives(page_))
+  
+  Call Dev_NewCase("Invalid enumerated representatives")
+  iSchema.Text = "ÊÑ2 Test"
+  iProxy.Text = "ÊÑ1 Test"
+  Call Dev_ExpectEQ(iReps, ExtractRepresentatives(page_))
+  
+  Call Dev_NewCase("Unrelated proxy")
+  iSchema.Text = "ÊÑ1 Test"
+  iProxy.Text = "ÊÑ1 Test1337"
+  Call Dev_ExpectEQ(0, ExtractRepresentatives(page_).Count)
+  
+  Call Dev_NewCase("Duplicate schema")
+  Dim iDuplicate As Visio.Shape: Set iDuplicate = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 30, 30)
+  iDuplicate.Text = iSchema.Text
+  Call Dev_ExpectEQ(0, ExtractRepresentatives(page_).Count)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ExtractPowerLevels()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectEQ(0, ExtractPowerLevels(page_).Count, "Empty page")
+  
+  Call Dev_NewCase("Unlinked nodes")
+  Dim ks1 As Visio.Shape: Set ks1 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 30, 30)
+  Dim ks2 As Visio.Shape: Set ks2 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 25, 25)
+  Dim ks3 As Visio.Shape: Set ks3 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 20, 20)
+  Dim ks4 As Visio.Shape: Set ks4 = page_.Drop(FindMaster(ThisDocument, MASTER_SCHEMA), 35, 35)
+  Dim iOperation As Visio.Shape: Set iOperation = page_.Drop(FindMaster(ThisDocument, MASTER_OPERATION), 15, 15)
+  Dim iLevels As New Scripting.Dictionary
+  iLevels(ks1.ID) = 1
+  iLevels(ks2.ID) = 1
+  iLevels(ks3.ID) = 1
+  iLevels(ks4.ID) = 1
+  iLevels(iOperation.ID) = 1
+  Call Dev_ExpectEQ(iLevels, ExtractPowerLevels(page_))
+  
+  Call Dev_NewCase("Valid graph")
+  Call ks1.AutoConnect(iOperation, visAutoConnectDirNone)
+  Call ks2.AutoConnect(iOperation, visAutoConnectDirNone)
+  Call iOperation.AutoConnect(ks3, visAutoConnectDirNone)
+  Call ks3.AutoConnect(ks4, visAutoConnectDirNone)
+  Call ks1.AutoConnect(ks4, visAutoConnectDirNone)
+  iLevels(ks3.ID) = 2
+  iLevels(ks4.ID) = 3
+  iLevels(iOperation.ID) = 2
+  Call Dev_ExpectEQ(iLevels, ExtractPowerLevels(page_))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/s_Operations.cls

@@ -0,0 +1,47 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_Operations"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ====== Test block operations ======
+Option Explicit
+
+' TODO:
+' Public Function EnumerateSchemasOn(target As Visio.Page)
+' Public Function FixEnumerationOn(target As Visio.Page)
+' Public Function ToggleHeadersSelected(iSelected As Visio.Selection)
+' Public Function ToggleHeadersAll(iPage As Visio.Page)
+' Public Function ToggleHighlight(targets As Visio.Selection)
+' Public Function ToggleInherited(targets As Visio.Selection)
+' Public Function ToggleMiniatures(target As Visio.Page)
+' Public Function ReflectParents(target As Visio.Shape)
+' Public Function ToggleThemeColors(iPage As Visio.Page)
+
+' Public Function ExportExcel(iSource As Visio.Page, iDestination As Excel.Workbook)
+' Public Function ExportWord(iSource As Visio.Page, iDestination As Word.Document, iOrder As Collection)
+
+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_Init()
+  On Error GoTo PROPAGATE_ERROR
+  
+  
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/z_UIMessages.bas

@@ -0,0 +1,72 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_SELECT_ELEMENT
+  EM_SELECT_SCHEMA
+  EM_MISSING_TEMPLATE
+  EM_MINIMIZE_CONTAINERS_ONLY
+  EM_OPERANDS_MISSING
+  EM_WORD_MISSING_TEMPLATE
+  
+  IM_EXPORT_OK
+
+'  QM_CLEAR_ALL
+End Enum
+
+Private g_UI As API_UserInteraction
+
+Public Function UserInteraction() As API_UserInteraction
+  If g_UI Is Nothing Then _
+    Set g_UI = New API_UserInteraction
+  Set UserInteraction = g_UI
+End Function
+
+Public Function SetUserInteraction(newUI As API_UserInteraction)
+  Set g_UI = newUI
+End Function
+
+Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Select Case theCode
+    Case EM_SELECT_ELEMENT
+      Call MsgBox("Âûäåëèòå Ýëåìåíò", vbExclamation)
+    Case EM_SELECT_SCHEMA
+      Call MsgBox("Âûäåëèòå îäíó ÊÑ", vbExclamation)
+    Case EM_MISSING_TEMPLATE
+      Call MsgBox("Íå óäàëîñü íàéòè øàáëîí. Áóäåò ñîçäàí ïóñòîé äîêóìåíò", vbExclamation)
+    Case EM_MINIMIZE_CONTAINERS_ONLY
+      Call MsgBox("Ìèíèçèðîâàòü ìîæíî òîëüêî êîíòåéíåðû", vbExclamation)
+    Case EM_OPERANDS_MISSING
+      Call MsgBox("Îïåðàöèÿ ïðèìåíèìà òîëüêî ê ÊÑ ñ 1 èëè áîëåå ïðåäêàìè", vbExclamation)
+    Case EM_WORD_MISSING_TEMPLATE
+      Call MsgBox("Íå óäàëîñü íàéòè øàáëîí", vbExclamation)
+    
+    Case IM_EXPORT_OK
+      Call MsgBox("Âûãðóçêà çàâåðøåíà", vbInformation)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+'  Case QM_CLEAR_ALL
+'    answer = MsgBox("Óäàëèòü âñå ôèãóðû ñ òåêóùåé ñòðàíèöû?", vbYesNo + vbQuestion)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/z_UIRibbon.bas

@@ -0,0 +1,26 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+
+Public Sub OnAction(iControl As IRibbonControl)
+  Select Case iControl.ID
+    Case "ToggleHeaders":     Call RunToggleHeaders
+    Case "ToggleMiniatures":  Call RunToggleMiniatures
+    Case "CycleType":         Call RunCycleElementType
+    Case "ToggleInherited":   Call RunToggleInherited
+    Case "ToggleHighlight":   Call RunToggleHighlight
+    Case "ReflectParents":    Call RunReflectParents
+    Case "FixEnumeration":    Call RunFixEnumeration
+    Case "EnumerateAll":      Call RunEnumerateSchemas
+    
+    Case "ExportWord":        Call RunExportWord
+    Case "ExportExcel":       Call RunExportExcel
+    Case "ToggleTheme":       Call RunToggleColorTheme
+    Case "GlobalHelp":        Call RunHelp
+    
+    Case Else: Call CC_DispatchCommand(iControl.ID)
+  End Select
+End Sub
+
+Public Sub OnUpdateRibbon(iControl As IRibbonControl, ByRef returnedVal)
+  returnedVal = True
+End Sub

ui/.rels

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId3" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/thumbnail" Target="docProps/thumbnail.emf"/><Relationship Id="rId2" Type="http://schemas.microsoft.com/office/2007/relationships/ui/extensibility" Target="visio/customUI/customUI1.xml"/><Relationship Id="rId1" Type="http://schemas.microsoft.com/visio/2010/relationships/document" Target="visio/document.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties" Target="docProps/custom.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId4" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/></Relationships>

ui/customUI1.xml

@@ -0,0 +1,125 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
+	<ribbon>
+	<tabs>
+	<tab id="Blocks" label="Концепт.Блоки">
+	<group id="Blocks.Actions" label="Действия">
+		<button id="ToggleHeaders" size="large"
+			label="Заголовки"
+			supertip="Включить / выключить заголовки в выделенных блоках [Ctrl+T]"
+			imageMso="SetFieldAsTitle"
+			onAction="OnAction"/>
+		<button id="ToggleMiniatures" size="large"
+			label="Выжимка"
+			supertip="Включить / выключить режим отображения ключевого содержания [Ctrl+Shift+T]"
+			imageMso="AutoSummarize"
+			onAction="OnAction"/>
+				
+		<button id="WidthAdd10"
+			label="+1см"
+			supertip="Увеличить ширину [Ctrl+E]"
+			imageMso="OutlineSubtasksShow"
+			onAction="OnAction"/>
+		<button id="WidthSub10"
+			label="-1см"
+			supertip="Уменьшить ширину [Ctrl+Q]"
+			imageMso="OutlineSubtasksHide"
+			onAction="OnAction"/>
+		<button id="CycleType"
+			label="Тип"
+			supertip="Следующий тип элемента [Ctrl+R]"
+			imageMso="DiagramCycleInsertClassic"
+			onAction="OnAction"/>
+				
+		<button id="ToggleHighlight"
+			label="Ключевой"
+			supertip="Задать статус ключевых элементов [Ctrl+Shift+R]"
+			imageMso="AuthorHighlightingHide"
+			onAction="OnAction"/>
+		<button id="ToggleInherited"
+			label="Наследник"
+			supertip="Изменить статус элементов-наследников"
+			imageMso="InheritPermissions"
+			onAction="OnAction"/>
+			
+		<button id="TopAlignment" size="large"
+			label="Выровнять верх"
+			supertip="Выровнять строки по верхнеиу краю"
+			imageMso="ObjectsAlignTopSmart"
+			onAction="OnAction"/>
+		<button id="LeftAlignment" size="large"
+			label="Выровнять лево"
+			supertip="Выровнять колонны по левому краю"
+			imageMso="ObjectsAlignLeftSmart"
+			onAction="OnAction"/>
+		<button id="ReflectParents" size="large"
+			label="Отразить предков"
+			supertip="Отразить предков относительно выбранной КС"
+			imageMso="AlignJustifyThai"
+			onAction="OnAction"/>
+		<button id="FixEnumeration" size="large"
+			label="Исправить номера"
+			supertip="Добавить номера ненумерованным КС"
+			imageMso="ReviewAcceptOrRejectChangeDialog"
+			onAction="OnAction"/>
+		<button id="EnumerateAll" size="large"
+			label="Нумеровать заново"
+			supertip="Перенумеровать все КС"
+			imageMso="RecurrenceEditSeries"
+			onAction="OnAction"/>
+	</group>
+	
+	<group id="Blocks.Navigation" label="Навигация">
+		<button id="ExpandStraight" size="large"
+			label="Потомки"
+			supertip="Добавить в выделение всех потомков"
+			imageMso="DiagramExpandClassic"
+			onAction="OnAction"/>
+		<button id="ExpandReverse" size="large"
+			label="Предки"
+			supertip="Добавить в выделение всех предков"
+			imageMso="DiagramFitToContentsClassic"
+			onAction="OnAction"/>
+		<button id="GotoLinkBegin"
+			label="В начало"
+			supertip="Переход к началу выделенной стрелки [Ctrl+Shift+Q]"
+			imageMso="JotNavUIFindRTL"
+			onAction="OnAction"/>
+		<button id="GotoLinkEnd"
+			label="В конец"
+			supertip="Переход к концу выделенной стрелки [Ctrl+Shift+E]"
+			imageMso="JotNavUIFind"
+			onAction="OnAction"/>
+		<button id="IterateSimilar" size="large"
+			label="Схожие"
+			supertip="Переход к следующей фигуре со схожим ID (префикс или текст) [Ctrl+Shift+F]"
+			imageMso="EquationDelimiterGallery"
+			onAction="OnAction"/>
+	</group>
+	
+	<group id="Blocks.Extension" label="Дополнительно">
+		<button id="ExportWord" size="large"
+			label="Выгрузить Word"
+			supertip="Выгрузить схему в Word"
+			imageMso="ExportWord"
+			onAction="OnAction"/>
+		<button id="ExportExcel" size="large"
+			label="Выгрузить Excel"
+			supertip="Выгрузить схему в Excel"
+			imageMso="ExportExcel"
+			onAction="OnAction"/>
+		<button id="ToggleTheme" size="large"
+			label="Яркость цветов"
+			supertip="Изменить яркость цветов элементов для печати/чтения"
+			imageMso="AppointmentColorDialog"
+			onAction="OnAction"/>
+		<button id="GlobalHelp" size="large"
+			label="Справка"
+			supertip="Вызов справки" 
+			imageMso="Info"
+			onAction="OnAction"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>