Initial commit

VBAMake.txt

@@ -0,0 +1,40 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home, install_home
+
+id = Concept-Defs
+name = Концепт-Определения
+description = Технология анализа нормативных определений
+artifact_home = Концепт-Определения
+source_home = Concept-Defs
+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 <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+build script\manifest.txt
+save_as Карта понятий.vsdm -> 22 Карта понятий.vstm
+copy distr\Определения-Excel.xltx -> Определения-Excel.xltx
+copy distr\!Руководство пользователя.docx -> !Руководство пользователя.docx
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+install Определения-Excel.xltx
+install !Руководство пользователя.docx
+install Карта понятий.vsdm
+
+add_template 22 Карта понятий.vstm
+add_template Определения-Excel.xltx -> Технологии\Определения-Excel.xltx

VERSION

@@ -0,0 +1 @@
+1.4.0

script/manifest.txt

@@ -0,0 +1,96 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = Карта понятий.vsdm
+artifact = Карта понятий.vsdm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+dev
+	DevTester.bas
+
+api
+	ex_Python.bas
+	ex_WinAPI.bas
+	
+	API_Python.cls
+	API_VsoWrapper.cls
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+excel
+	API_XLRecordsWrapper.cls
+
+utility
+	ex_VBA.bas
+	ex_Collection.bas
+	ex_Version.bas
+	
+	API_DistrManifest.cls
+	API_Config.cls
+	API_JSON.cls
+	CDS_Factorizator.cls
+	CDS_Edge.cls
+	CDS_Node.cls
+	CDS_Graph.cls
+	API_StrongComponents.cls
+	
+visio
+	API_UndoWrapper.cls
+	z_VsoGraph.bas
+	z_VsoUtilities.bas
+	z_CCVsoExtension.bas
+	
+ui
+	CSE_ProgressBar.frm
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	NewConcept.frm
+	GridDlg.frm
+	
+	DevHelper.bas
+	Declarations.bas
+	Main.bas
+	MainImpl.bas
+	z_UIRibbon.bas
+	z_UIMessages.bas
+
+	RankGrid.cls
+	TermItem.cls
+	Exporter.cls
+	ComparatorExporter.cls
+	
+	s_RankGrid.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 : MSForms
+global : Shell32
+global : Excel

src/ComparatorExporter.cls

@@ -0,0 +1,83 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ComparatorExporter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private outWB_ As Excel.Workbook
+Private outCmp_ As Excel.Worksheet
+
+Private src1_ As Visio.Page
+Private src2_ As Visio.Page
+
+Private sourceNames_ As New Collection
+
+Public Function Init(iDestination As Excel.Workbook)
+  Set outWB_ = iDestination
+End Function
+
+Public Function RunCompare(src1 As Visio.Page, src2 As Visio.Page)
+  Dim out1_ As New API_XLRecordsWrapper: Call out1_.Init(outWB_.Sheets(1))
+  Dim out2_ As New API_XLRecordsWrapper: Call out2_.Init(outWB_.Sheets(2))
+  Dim items1 As Collection: Set items1 = ScanDataFrom(src1, out1_)
+  Dim items2 As Collection: Set items2 = ScanDataFrom(src2, out2_)
+  Call OutputComparison(items1, items2)
+End Function
+
+' =============
+Private Function ScanDataFrom(src As Visio.Page, ByRef out As API_XLRecordsWrapper) As Collection
+  Set ScanDataFrom = New Collection
+  
+  Dim aShape As Visio.Shape
+  For Each aShape In src.Shapes
+    If aShape.OneD Then _
+      GoTo NEXT_SHAPE
+    
+    Dim theType As ShapeType: theType = GetShapeType(aShape)
+    If theType = STYPE_GRID Or theType = STYPE_UNKNOWN Then _
+      GoTo NEXT_SHAPE
+    
+    out.Field(XL_TS_ID) = aShape.ID
+    
+    If theType = STYPE_DERIVED Then
+      out.Field(XL_TS_NAME) = VBA.Trim(aShape.Shapes(S_D_TERM).Text)
+      out.Field(XL_TS_DEFINITION) = aShape.Shapes(S_D_DEFINITION).Text
+      out.Field(XL_TS_DEFINITION).WrapText = False
+    Else
+      out.Field(XL_TS_NAME) = Trim(aShape.Text)
+    End If
+    
+    Call SafeAddToCollection(out.Field(XL_TS_NAME), out.Field(XL_TS_NAME), ScanDataFrom)
+    Call out.MoveNext
+NEXT_SHAPE:
+  Next aShape
+End Function
+
+Private Function OutputComparison(src1 As Collection, src2 As Collection)
+  Dim out1_ As New API_XLRecordsWrapper: Call out1_.Init(outWB_.Sheets(3))
+  Dim out2_ As New API_XLRecordsWrapper: Call out2_.Init(outWB_.Sheets(3))
+  Dim outCommon_ As New API_XLRecordsWrapper: Call outCommon_.Init(outWB_.Sheets(3))
+  
+  Dim strItem As Variant
+  For Each strItem In src1
+    If InCollection(CStr(strItem), src2) Then
+      outCommon_.Field(XL_COMP_SHARED) = strItem
+      Call outCommon_.MoveNext
+    Else
+      out1_.Field(XL_COMP_1ST) = strItem
+      Call out1_.MoveNext
+    End If
+  Next strItem
+  
+  For Each strItem In src2
+    If Not InCollection(CStr(strItem), src1) Then
+      out2_.Field(XL_COMP_2ND) = strItem
+      Call out2_.MoveNext
+    End If
+  Next strItem
+End Function

src/Declarations.bas

@@ -0,0 +1,150 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+
+Public Const APP_HELP = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\Êîíöåïò-Îïðåäåëåíèÿ\!Ðóêîâîäñòâî ïîëüçîâàòåëÿ.docx"
+
+Public Const MASTER_BASIC = "Èñõîäíîå ïîíÿòèå"
+Public Const MASTER_DERIVED = "Ïîíÿòèå"
+Public Const MASTER_LEVEL = "Ãðàíèöà óðîâíåé"
+
+Public Const SHAPE_DERVIED = "STermName"
+
+Public Const PREFIX_GRID = "SLevel"
+Public Const MASK_LEVEL = "SLevel*"
+
+Public Const COLOR_MENTION = "RGB(0,176,240)"
+Public Const COLOR_INVALID = "RGB(192,0,0)"
+
+Public Const RANK_MAX = 15
+Public Const RANK_UNREACHABLE = -1
+
+Public Const SHAPE_BASIC = "SBasic"
+Public Const SHAPE_DERIVED = "SDefinedNotion"
+Public Const SHAPE_BLOCK = "SBlock"
+Public Const SHAPE_CONNECTOR = "SConnector"
+Public Const SHAPE_LEVEL = "SLevel"
+
+Public Const VSO_CELL_LTYPE = "User.LinkType"
+Public Const VSO_CELL_SOLID = "User.IsSolid"
+Public Const VSO_CELL_BOLD = "User.IsBold"
+Public Const VSO_BASIC_LTYPE = "User.Type"
+
+Public Const V_GAP = 6.5 / 28.35  ' cm
+Public Const H_GAP = 3 / 28.35 ' cm
+Public Const GRID_X_MARGIN = 40 ' mm
+
+Public Const MOST_LEFT = -99999
+
+Public Const BASE_START = 5
+Public Const BASIC_COLOMNS = 5
+Public Const DERIVED_ROWS = 5
+
+Public Enum ShapeType
+  STYPE_UNKNOWN = 0
+  STYPE_BASIC = 1
+  STYPE_TODO = 2
+  STYPE_ANNOUNCED = 3
+  STYPE_UNCLEAR = 4
+  STYPE_DERIVED = 5
+  STYPE_BLOCK = 6
+  STYPE_LINK = 7
+  STYPE_GRID = 8
+End Enum
+
+Public Enum LinkType
+  LT_DEFINE = 1
+  LT_CIRCLE = 2
+  LT_SYNON = 3
+  LT_OMON = 4
+  LT_CONSISTS = 5
+End Enum
+
+Public Enum DerivedStructure
+  S_D_TERM = 1
+  S_D_SOURCE = 2
+  S_D_DEFINITION = 3
+End Enum
+
+' -------- Excel -------------
+Public Const TEMPLATE_PREFIX = "Òåõíîëîãèè"
+Public Const SERVER_TEMPLATES = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\Êîíöåïò-Îïðåäåëåíèÿ"
+
+Public Const XL_TEMPLATE_NAME = "Îïðåäåëåíèÿ-Excel.xltx"
+
+Public Const XL_SHEET_SHAPES = "Ôèãóðû"
+Public Const XL_SHEET_LINKS = "Ñâÿçè"
+Public Const XL_SHEET_MENTIONS = "Âõîæäåíèÿ"
+Public Const XL_SHEET_CYCLES = "Öèêëû"
+
+Public Enum ThesaurusStruct
+  XL_TS_ID = 1
+  XL_TS_NAME = 2
+  XL_TS_DEFINITION = 3
+End Enum
+
+Public Enum CompareStruct
+  XL_COMP_1ST = 1
+  XL_COMP_2ND = 2
+  XL_COMP_SHARED = 3
+End Enum
+
+Public Enum FullExportStruct
+  XL_COL_ID = 1
+  XL_COL_TYPE = 2
+  XL_COL_TERMNAME = 3
+  XL_COL_DEFINITION = 4
+  XL_COL_SOURCE = 5
+  XL_COL_PARENT = 6
+  XL_COL_COPY = 7
+  XL_COL_PINX = 8
+  XL_COL_PINY = 9
+  XL_COL_WIDTH = 10
+  XL_COL_HEIGHT = 11
+  XL_COL_LINECOLOR = 12
+  XL_COL_TEXTCOLOR = 13
+End Enum
+
+Public Enum MentionsStruct
+  XL_MENT_ID = 1
+  XL_MENT_START = 2
+  XL_MENT_FINISH = 3
+  XL_MENT_TEXT = 4
+  XL_MENT_COLOR = 5
+  XL_MENT_STYLE = 6
+End Enum
+
+Public Function GetExportTemplate(sFile$) As String
+  Dim fso As New Scripting.FileSystemObject
+  
+  GetExportTemplate = SERVER_TEMPLATES & "\" & sFile
+  If fso.FileExists(GetExportTemplate) Then _
+    Exit Function
+  
+  GetExportTemplate = ThisDocument.Path & sFile
+  If fso.FileExists(GetExportTemplate) Then _
+    Exit Function
+
+  GetExportTemplate = TEMPLATE_PREFIX & "\" & sFile
+End Function
+
+Public Function GetShapeType(target As Visio.Shape) As ShapeType
+  If target.MasterShape Is Nothing Then
+    GetShapeType = STYPE_UNKNOWN
+    Exit Function
+  End If
+  
+  Select Case (target.MasterShape.Name)
+    Case SHAPE_BASIC: GetShapeType = target.CellsU(VSO_BASIC_LTYPE)
+    Case SHAPE_DERIVED: GetShapeType = STYPE_DERIVED
+    Case SHAPE_BLOCK: GetShapeType = STYPE_BLOCK
+    Case SHAPE_CONNECTOR: GetShapeType = STYPE_LINK
+    Case SHAPE_LEVEL: GetShapeType = STYPE_GRID
+    Case Else: GetShapeType = STYPE_UNKNOWN
+  End Select
+End Function
+
+Public Function IsShapeDuplicate(target As Visio.Shape) As Boolean
+  If CellsExists(target, VSO_CELL_SOLID) Then _
+    IsShapeDuplicate = IIf(target.CellsU(VSO_CELL_SOLID), False, True)
+End Function
+

src/DevHelper.bas

@@ -0,0 +1,22 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+    Call ClearAllExceptGrid(ActivePage)
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_RankGrid"
+  Dim sTest$: sTest = "t_ChangeWidth"
+  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_RankGrid": Set Dev_GetTestSuite = New s_RankGrid
+  End Select
+End Function

src/Exporter.cls

@@ -0,0 +1,259 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "Exporter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ==== Excel export manager =========
+Option Explicit
+
+Private links_ As API_XLRecordsWrapper
+Private shapes_ As API_XLRecordsWrapper
+Private mentions_ As API_XLRecordsWrapper
+Private cycles_ As API_XLRecordsWrapper
+Private graph_ As CDS_Graph
+Private terms_ As Scripting.Dictionary
+Private mutualEdges_ As Scripting.Dictionary
+Private thePage_ As Visio.Page
+
+Public Function Init(iOut As Excel.Workbook)
+  Set links_ = New API_XLRecordsWrapper: Call links_.Init(iOut.Sheets(XL_SHEET_LINKS))
+  Set shapes_ = New API_XLRecordsWrapper: Call shapes_.Init(iOut.Sheets(XL_SHEET_SHAPES))
+  Set mentions_ = New API_XLRecordsWrapper: Call mentions_.Init(iOut.Sheets(XL_SHEET_MENTIONS))
+  Set cycles_ = New API_XLRecordsWrapper: Call cycles_.Init(iOut.Sheets(XL_SHEET_CYCLES), 1)
+  Set graph_ = New CDS_Graph
+  Set terms_ = New Scripting.Dictionary
+  Set mutualEdges_ = New Scripting.Dictionary
+End Function
+
+Public Function ScanDataFrom(iSource As Visio.Page)
+  Set thePage_ = iSource
+  
+  Call CSE_ProgressBar.Init("Âûãðóçêà äàííûõ", sHeader:="Îáðàáîòêà ôèãóð", maxVal:=2 * thePage_.Shapes.Count)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Call ScanShapes
+  Call ProcessDuplicates
+  Call OutputCycles
+
+  Unload CSE_ProgressBar
+End Function
+
+' ========
+Private Function ScanShapes()
+  Dim aShape As Visio.Shape
+  For Each aShape In thePage_.Shapes
+    If aShape.OneD Then
+      Call ScanLink(aShape)
+    Else
+      Call ScanTerm(aShape)
+    End If
+    Call CSE_ProgressBar.IncrementA
+  Next aShape
+End Function
+
+Private Function ProcessDuplicates()
+  Dim aShape As Visio.Shape
+  For Each aShape In thePage_.Shapes
+    If aShape.OneD Or Not aShape.CellExistsU(VSO_CELL_SOLID, visExistsAnywhere) Then _
+      GoTo NEXT_SHAPE
+    If aShape.CellsU(VSO_CELL_SOLID) Then _
+      GoTo NEXT_SHAPE
+    
+    Dim sText$
+    If GetShapeType(aShape) = STYPE_DERIVED Then
+      sText = aShape.Shapes(S_D_DEFINITION).Text
+    Else
+      sText = aShape.Text
+    End If
+    If Not terms_.Exists(sText) Then _
+      GoTo NEXT_SHAPE
+    
+    Dim originalID&: originalID = terms_(sText)
+    If originalID = aShape.ID Then _
+      GoTo NEXT_SHAPE
+      
+    Dim edge1 As CDS_Edge: Set edge1 = graph_.AddEdge(aShape.ID, originalID)
+    If Not edge1 Is Nothing Then _
+      Call mutualEdges_.Add(edge1.ID, 0)
+    Dim edge2 As CDS_Edge: Set edge2 = graph_.AddEdge(originalID, aShape.ID)
+    If Not edge2 Is Nothing Then _
+      Call mutualEdges_.Add(edge2.ID, 0)
+    
+NEXT_SHAPE:
+    Call CSE_ProgressBar.IncrementA
+  Next aShape
+End Function
+
+Private Function OutputCycles()
+  Dim scc As New API_StrongComponents
+  Dim components As Collection: Set components = scc.GetComponents(graph_)
+  Dim vComponent As Scripting.Dictionary
+  Dim nShapeID As Variant
+  For Each vComponent In components
+    If CheckCycle(vComponent) Then
+      Dim nColumn&: nColumn = 1
+      For Each nShapeID In vComponent
+        Dim aShape As Visio.Shape: Set aShape = thePage_.Shapes.ItemFromID(nShapeID)
+        If aShape.Shapes.Count = 3 Then
+          cycles_.Field(nColumn) = aShape.Shapes(S_D_TERM).Text & " (" & nShapeID & ")"
+        Else
+          cycles_.Field(nColumn) = aShape.Text & " (" & nShapeID & ")"
+        End If
+        nColumn = nColumn + 1
+      Next nShapeID
+      Call cycles_.MoveNext
+    End If
+  Next vComponent
+End Function
+
+' ============
+Private Function ScanLink(target As Visio.Shape)
+  If target.Connects.Count <> 2 Then _
+    Exit Function
+    
+  Dim nSource$: nSource = target.Connects(1).ToSheet.ID
+  Dim nDest$: nDest = target.Connects(2).ToSheet.ID
+  
+  links_.Field(1) = target.ID
+  links_.Field(2) = nSource
+  links_.Field(3) = nDest
+  
+  If GetShapeType(target) = STYPE_LINK Then
+    Dim tLink&: tLink = target.CellsU(VSO_CELL_LTYPE)
+    links_.Field(4) = tLink
+    links_.Field(5) = IIf(target.CellsU(VSO_CELL_SOLID), 0, 1)
+    links_.Field(6) = IIf(target.CellsU(VSO_CELL_BOLD), 1, 0)
+    
+    If tLink <> LT_OMON And tLink <> LT_CONSISTS Then
+      Call graph_.AddEdge(nSource, nDest)
+      If tLink = LT_SYNON Then
+        Dim newEdge As CDS_Edge: Set newEdge = graph_.AddEdge(nDest, nSource)
+        If Not newEdge Is Nothing Then
+          mutualEdges_.Item(newEdge.ID) = 0
+          mutualEdges_.Item(newEdge.Reversed.ID) = 0
+        End If
+      End If
+    End If
+  End If
+  
+  Call links_.MoveNext
+End Function
+
+Private Function ScanTerm(target As Visio.Shape)
+  Dim theType As ShapeType: theType = GetShapeType(target)
+  If theType = STYPE_GRID Then _
+    Exit Function
+    
+  Call graph_.AddNode(target.ID)
+  
+  shapes_.Field(XL_COL_ID) = target.ID
+  shapes_.Field(XL_COL_TYPE) = theType
+  shapes_.Field(XL_COL_PINX) = target.CellsU("PinX").result(visMillimeters)
+  shapes_.Field(XL_COL_PINY) = target.CellsU("PinY").result(visMillimeters)
+  shapes_.Field(XL_COL_WIDTH) = target.CellsU("Width").result(visMillimeters)
+  shapes_.Field(XL_COL_HEIGHT) = target.CellsU("Height").result(visMillimeters)
+  shapes_.Field(XL_COL_LINECOLOR) = target.CellsU("LineColor")
+  shapes_.Field(XL_COL_TEXTCOLOR) = target.CellsU("Char.Color")
+  
+  If theType = STYPE_DERIVED Then
+    shapes_.Field(XL_COL_TERMNAME) = target.Shapes(S_D_TERM).Text
+    shapes_.Field(XL_COL_DEFINITION) = target.Shapes(S_D_DEFINITION).Text
+    shapes_.Field(XL_COL_SOURCE) = target.Shapes(S_D_SOURCE).Text
+    
+    Call ScanMentions(target.ID, target.Shapes(S_D_DEFINITION))
+  Else
+    shapes_.Field(XL_COL_TERMNAME) = target.Text
+  End If
+  
+  Dim parent As Visio.Shape: Set parent = GetContainingShape(target)
+  If Not parent Is Nothing Then
+    shapes_.Field(XL_COL_PARENT) = parent.ID
+  End If
+  
+  If theType <= STYPE_DERIVED And theType >= STYPE_BASIC Then
+    Dim isCopy&: isCopy = IIf(target.CellsU(VSO_CELL_SOLID), 0, 1)
+    shapes_.Field(XL_COL_COPY) = isCopy
+    If Not isCopy Then _
+      Call terms_.Add(shapes_.Field(XL_COL_TERMNAME), target.ID)
+  End If
+  
+  Call shapes_.MoveNext
+End Function
+
+Private Function ScanMentions(nID&, target As Visio.Shape)
+  Dim sText$: sText = target.Text
+  
+  Dim nSection&: nSection = 0
+  Dim nStart&: nStart = 0
+  Dim nFinish&: nFinish = 1
+  Dim nLast&: nLast = target.Characters.End
+  
+  Dim iChars As Visio.Characters: Set iChars = target.Characters
+  iChars.Begin = nStart
+  iChars.End = nFinish
+  Do While nSection < target.RowCount(visSectionCharacter) - 1
+    Do While nSection = iChars.CharPropsRow(visBiasRight) And nFinish <> nLast
+      nFinish = nFinish + 1
+      iChars.End = nFinish
+    Loop
+    nFinish = nFinish - 1
+
+    Dim sColor$: sColor = target.CellsSRC(visSectionCharacter, nSection, visCharacterColor)
+    Dim sStyle$: sStyle = target.CellsSRC(visSectionCharacter, nSection, visCharacterStyle)
+    Dim sItem$: sItem = FixShapeText(VBA.Mid(sText, nStart + 1, nFinish - nStart))
+    If IsNotEmpty(sItem) And (Not IsDefaultColor(sColor) Or Not IsDefaultStyle(sStyle)) Then
+      mentions_.Field(XL_MENT_ID) = nID
+      mentions_.Field(XL_MENT_TEXT) = sItem
+      mentions_.Field(XL_MENT_START) = nStart
+      mentions_.Field(XL_MENT_FINISH) = nFinish
+      mentions_.Field(XL_MENT_COLOR) = sColor
+      mentions_.Field(XL_MENT_STYLE) = sStyle
+  
+      Call mentions_.MoveNext
+    End If
+    
+    iChars.Begin = nFinish
+    nStart = nFinish
+    nSection = nSection + 1
+ Loop
+End Function
+
+Private Function FixShapeText(sText$) As String
+  FixShapeText = Trim(sText)
+  FixShapeText = Replace(FixShapeText, Chr(9), " ")
+  FixShapeText = Replace(FixShapeText, Chr(160), " ")
+  FixShapeText = Trim(FixShapeText)
+End Function
+
+Private Function IsNotEmpty(sText$) As Boolean
+  IsNotEmpty = sText <> "" And Not sText Like "[,.!?:;]"
+End Function
+
+Private Function IsDefaultColor(sColor$) As Boolean
+  IsDefaultColor = sColor = "0" Or sColor = "30"
+End Function
+
+Private Function IsDefaultStyle(sStyle$) As Boolean
+  IsDefaultStyle = sStyle = "0"
+End Function
+
+Private Function CheckCycle(target As Scripting.Dictionary) As Boolean
+  If target.Count < 2 Then
+    CheckCycle = True
+    Exit Function
+  End If
+
+  Dim anEdge As CDS_Edge
+  For Each anEdge In graph_.FilterInternalEdges(target)
+    If Not mutualEdges_.Exists(anEdge.ID) Then
+      CheckCycle = True
+      Exit Function
+    End If
+  Next anEdge
+  CheckCycle = False
+End Function
+

src/GridDlg.frm

@@ -0,0 +1,45 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} GridDlg 
+   Caption         =   "Ïàðàìåòðû ñåòêè"
+   ClientHeight    =   2205
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   3540
+   OleObjectBlob   =   "GridDlg.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "GridDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCancelled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCancelled_ = True
+End Sub
+
+Private Sub OkBtn_Click()
+  isCancelled_ = False
+  Me.Hide
+End Sub
+
+Private Sub CancelBtn_Click()
+  isCancelled_ = True
+  Me.Hide
+End Sub
+
+Public Property Get LevelCount() As Long
+  LevelCount = Me.CountTB.Value
+End Property
+
+Public Property Get LevelHeight() As Long
+  LevelHeight = Me.HeightTB.Value
+End Property
+
+Public Property Get FirstGap() As Long
+  FirstGap = Me.FirstLevelTB.Value
+End Property
+

src/Main.bas

@@ -0,0 +1,323 @@
+Attribute VB_Name = "Main"
+' ============= Òåõíîëîãèÿ ðàáîòû ñ êàðòàìè ïîíÿòèé ==========
+Option Explicit
+
+Public Const PRODUCT_VERSION = "1.3.0"
+Public Const PRODUCT_NAME = "Concept-Defs"
+
+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 FixOldShapes()
+  Dim thePage As Visio.Page: Set thePage = ActivePage
+  Dim vsoShape As Visio.Shape
+  Dim i&: i = 1
+  For i = 1 To thePage.Shapes.Count Step 1
+    Set vsoShape = thePage.Shapes(i)
+    If GetShapeType(vsoShape) = STYPE_DERIVED Then
+      vsoShape.Shapes(2).CellsU("Width").Formula = "20mm"
+      vsoShape.Shapes(3).CellsU("Width").FormulaU = "=Sheet." & CStr(vsoShape.ID) & "!Width - Sheet." & CStr(vsoShape.Shapes(2).ID) & "!Width"
+    End If
+  Next i
+End Sub
+
+Public Sub RunImportExcel()
+  Dim theData As Collection: Set theData = PromptExcelData
+  If theData Is Nothing Then _
+    Exit Sub
+  
+  Dim vsoAppl As New API_VsoWrapper: Call vsoAppl.SetDocument(ThisDocument)
+  Call vsoAppl.PauseUI
+  Call GlobalUndo.BeginScope("Ïîñòðîåíèå ïðÿìîóãîëüíèêîâ")
+  
+  Call CSE_ProgressBar.Init("Ïîñòðîåíèå ñõåìû", sHeader:="Ãåíåðàöèÿ ôèãóð...", maxVal:=theData.Count)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Dim baseCount&, termCount&
+  Call BuildFromTerms(theData, baseCount, termCount)
+  
+  Call Unload(CSE_ProgressBar)
+  
+  Call GlobalUndo.EndScope
+  Call vsoAppl.ResumeUI
+  
+  Call UserInteraction.ShowMessage(IM_GENEARION_COMPLETE, baseCount, termCount)
+End Sub
+
+Public Sub RunAddNotion()
+  Call NewConcept.Show
+  If NewConcept.isCancelled_ = True Then _
+    Exit Sub
+  If IsNumeric(NewConcept.RankInput.Value) = False Then
+    Call UserInteraction.ShowMessage(EM_INVALID_LEVEL)
+    Exit Sub
+  End If
+  
+  Dim term As TermItem: Set term = NewConcept.GetTerm
+  Dim iRank%: iRank = NewConcept.RankInput.Value
+  Call Unload(NewConcept)
+  
+  Call GlobalUndo.BeginScope("Äîáàâèòü ïîíÿòèå")
+  
+  Call AddTermTo(term, ActivePage, iRank)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunGridPlus10()
+  Call GlobalUndo.BeginScope("Èçìåíèòü ñåòêó")
+  
+  If Not ActiveGrid.IncrementWidth(Visio.Application.ConvertResult(100, visMillimeters, visInches)) Then _
+    Call UIShowMessage(EM_INVALID_WIDTH)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunGridMinus10()
+  Call GlobalUndo.BeginScope("Èçìåíèòü ñåòêó")
+  
+  If Not ActiveGrid.IncrementWidth(Visio.Application.ConvertResult(-100, visMillimeters, visInches)) Then _
+    Call UIShowMessage(EM_INVALID_WIDTH)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunGridChange()
+  Dim sDiff$: sDiff = UserInteraction.PromptInput("Ââåäèòå èçìåíåíèå äëèíû ëèíèè â ìèëëèìåòðàõ", "Èçìåíåíèå óðîâíåé", 100)
+  If Not IsNumeric(sDiff) Then _
+    Exit Sub
+  Dim mmDiff&: mmDiff = CLng(sDiff)
+  
+  Call GlobalUndo.BeginScope("Èçìåíèòü ñåòêó")
+  
+  If Not ActiveGrid.IncrementWidth(Visio.Application.ConvertResult(mmDiff, visMillimeters, visInches)) Then _
+    Call UIShowMessage(EM_INVALID_WIDTH)
+
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunMoveUp()
+Attribute RunMoveUp.VB_ProcData.VB_Invoke_Func = "q"
+  Dim iSelected As Collection: Set iSelected = GetSelectedItems
+  If iSelected.Count = 0 Then
+    Call UserInteraction.ShowMessage(EM_EMPTY_SELECTION)
+    Exit Sub
+  End If
+  
+  ThisDocument.DiagramServicesEnabled = visServiceStructureBasic
+  Call GlobalUndo.BeginScope("Ïåðåìåñòèòü ââåðõ")
+  
+  Dim rGrid As RankGrid: Set rGrid = ActiveGrid
+  Dim vsoShape As Visio.Shape
+  For Each vsoShape In iSelected
+    Call rGrid.MoveUp(vsoShape)
+  Next vsoShape
+  
+  Call GlobalUndo.EndScope
+  ThisDocument.DiagramServicesEnabled = 0
+End Sub
+
+Public Sub RunMoveDown()
+Attribute RunMoveDown.VB_ProcData.VB_Invoke_Func = "e"
+  Dim iSelected As Collection: Set iSelected = GetSelectedItems
+  If iSelected.Count = 0 Then
+    Call UserInteraction.ShowMessage(EM_EMPTY_SELECTION)
+    Exit Sub
+  End If
+  
+  ThisDocument.DiagramServicesEnabled = visServiceStructureBasic
+  Call GlobalUndo.BeginScope("Ïåðåìåñòèòü âíèç")
+  
+  Dim rGrid As RankGrid: Set rGrid = ActiveGrid
+  Dim nOldSize%: nOldSize = rGrid.Size
+  Dim vsoShape As Visio.Shape
+  For Each vsoShape In iSelected
+    Call rGrid.MoveDown(vsoShape)
+  Next vsoShape
+  
+  If rGrid.Size <> nOldSize Then _
+    Call VsoSelectShapes(iSelected, ActivePage)
+  
+  Call GlobalUndo.EndScope
+  ThisDocument.DiagramServicesEnabled = 0
+End Sub
+
+Public Sub RunMoveToX()
+Attribute RunMoveToX.VB_ProcData.VB_Invoke_Func = "w"
+  Dim iSelected As Collection: Set iSelected = GetSelectedItems
+  If iSelected.Count = 0 Then
+    Call UserInteraction.ShowMessage(EM_EMPTY_SELECTION)
+    Exit Sub
+  End If
+  
+  Dim sRank$: sRank = UserInteraction.PromptInput("Ââåäèòå íîìåð óðîâíÿ", "Ïåðåìåùåíèå íà óðîâåíü", 1)
+  If Not IsNumeric(sRank) Then _
+    Exit Sub
+  Dim iRank%: iRank = VBA.Int(sRank)
+  If iRank > RANK_MAX Or iRank < 0 Then
+    Call UserInteraction.ShowMessage(EM_INVALID_LEVEL)
+    Exit Sub
+  End If
+  
+  ThisDocument.DiagramServicesEnabled = visServiceStructureBasic
+  Call GlobalUndo.BeginScope("Ïåðåìåñòèòü")
+  
+  Dim rGrid As RankGrid: Set rGrid = ActiveGrid
+  Dim nOldSize%: nOldSize = rGrid.Size
+  Dim vsoShape As Visio.Shape
+  For Each vsoShape In iSelected
+    Call rGrid.MoveToRank(vsoShape, iRank)
+  Next vsoShape
+  
+  If rGrid.Size <> nOldSize Then _
+    Call VsoSelectShapes(iSelected, ActivePage)
+  
+  Call GlobalUndo.EndScope
+  ThisDocument.DiagramServicesEnabled = 0
+End Sub
+
+Public Sub RunExportExcel()
+  Call Export2ExcelFrom(ActivePage)
+  Call UserInteraction.ShowMessage(IM_EXPORT_XL_COMPLETE)
+End Sub
+
+Public Sub RunCompare()
+  Dim sFileName$: sFileName = UserInteraction.PromptFileFilter( _
+                                sInitialPath:=ThisDocument.Path, _
+                                sDescription:="Visio file", _
+                                sFilter:="*.vsd*", _
+                                bNewApplication:=True)
+  If sFileName = vbNullString Then _
+    Exit Sub
+  
+  Dim thisDoc As Visio.Document: Set thisDoc = ActiveDocument
+  Dim wrap As New API_VsoWrapper
+  Call wrap.CreateApplication
+  If wrap.OpenDocument(sFileName, nOpenFlags:=visOpenRO + visOpenMacrosDisabled) Is Nothing Then _
+    Exit Sub
+  
+  Dim res As Boolean: res = ExportComparison(thisDoc, wrap.Document)
+  Call wrap.ReleaseDocument
+  
+  If res Then _
+    Call UserInteraction.ShowMessage(IM_EXPORT_DIFF_COMPLETE)
+End Sub
+
+Public Sub RunCleanUp()
+  Call GlobalUndo.BeginScope("Î÷èñòêà")
+  
+  Call ClearAllExceptGrid(Visio.ActivePage)
+  Visio.ActiveWindow.ViewFit = visFitPage
+  
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunAddGrid()
+  Call GridDlg.Show
+  If GridDlg.isCancelled_ = True Then _
+    Exit Sub
+  
+  Dim nCount%: nCount = GridDlg.LevelCount
+  Dim dTopMargin As Double: dTopMargin = Visio.Application.ConvertResult(GridDlg.FirstGap, visMillimeters, visInches)
+  Dim dHeight As Double: dHeight = Visio.Application.ConvertResult(GridDlg.LevelHeight, visMillimeters, visInches)
+  Dim dLeftMargin As Double: dLeftMargin = Visio.Application.ConvertResult(GRID_X_MARGIN, visMillimeters, visInches)
+  Dim dWidth As Double: dWidth = ActivePage.PageSheet.CellsU("PageWidth") - dLeftMargin
+  Unload GridDlg
+  
+  Call GlobalUndo.BeginScope("Ñîçäàòü óðîâíè")
+  
+  Call ActiveGrid.CreateGrid(nCount, dHeight:=dHeight, dWidth:=dWidth, dTopMargin:=dTopMargin, dLeftMargin:=dLeftMargin)
+
+  Call GlobalUndo.EndScope
+  
+End Sub
+
+Public Sub RunDeleteGrid()
+  Call GlobalUndo.BeginScope("Óäàëèòü óðîâíè")
+  
+  Call ActiveGrid.DeleteGrid
+  
+  Call GlobalUndo.EndScope
+End Sub
+
+Public Sub RunHelp()
+  Dim objWord As Object: Set objWord = CreateObject("Word.Application")
+  Dim objDoc As Object: Set objDoc = objWord.Documents.Open(APP_HELP, ReadOnly:=True)
+  With objWord
+    .Visible = True
+    .ActiveWindow.View.ReadingLayout = False
+    Call .Activate
+  End With
+End Sub
+
+' ===== Context menu API ========
+Public Function Automarkdown(target As Visio.Shape)
+  Dim iPage As Visio.Page: Set iPage = target.parent
+  Dim iTerms As Scripting.Dictionary: Set iTerms = ScanAllTerms(iPage)
+  Dim iDefinition As Visio.Shape: Set iDefinition = target.Shapes(S_D_DEFINITION)
+  
+  Call GlobalUndo.BeginScope("Àâòîðàçìåòêà")
+  
+  Dim sText$: sText = VBA.LCase(iDefinition.Text)
+  
+  Dim sTerm As Variant
+  Dim iFoundRange As Variant
+  Dim nStart&, nEnd&
+  Dim iSource As Visio.Shape
+  For Each sTerm In iTerms.Keys
+    On Error GoTo SAFE_EXIT
+    iFoundRange = AccessPython.CallFunction(PY_MODULE_TEXT, "find_substr", Array(sText, CStr(sTerm)))
+    If VarType(iFoundRange) = vbString Then
+      Call UserInteraction.ShowMessage(EM_PYTHON_ERROR, iFoundRange)
+      GoTo SAFE_EXIT
+    End If
+    On Error GoTo 0
+    nStart = iFoundRange(0)
+    nEnd = iFoundRange(1)
+    If nStart = nEnd Then _
+      GoTo NEXT_TERM
+    
+    Set iSource = iTerms(sTerm)
+    If iSource.ID = target.ID Then
+      Call VsoApplyColorTo(iDefinition, nStart, nEnd, COLOR_INVALID)
+    Else
+      Call VsoApplyColorTo(iDefinition, nStart, nEnd, COLOR_MENTION)
+      If Not VsoIsConnected(iSource, target) Then _
+        Call iSource.AutoConnect(target, visAutoConnectDirNone)
+    End If
+    
+NEXT_TERM:
+  Next sTerm
+  
+SAFE_EXIT:
+  Call GlobalUndo.EndScope
+End Function
+
+' =======
+Private Function GetSelectedItems() As Collection ' of Visio.Shape
+  Dim iShapes As New Collection
+  
+  Dim iSelected As Visio.Selection: Set iSelected = ActiveWindow.Selection
+  Dim vsoShape As Visio.Shape
+  For Each vsoShape In iSelected
+    If Not vsoShape.OneD Then _
+      If GetShapeType(vsoShape) <> STYPE_GRID Then _
+        Call iShapes.Add(vsoShape)
+NEXT_SHAPE:
+  Next vsoShape
+  
+  Set GetSelectedItems = iShapes
+End Function
+
+Private Function ActiveGrid() As RankGrid
+  Set ActiveGrid = New RankGrid
+  Call ActiveGrid.Init(ActivePage)
+End Function

src/MainImpl.bas

@@ -0,0 +1,296 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+
+Public Function ClearAllExceptGrid(target As Visio.Page)
+  Dim vsoShape As Visio.Shape
+  Dim i&: i = 1
+  Do While i <= target.Shapes.Count
+    Set vsoShape = target.Shapes(i)
+    If GetShapeType(vsoShape) = STYPE_GRID Then
+      i = i + 1
+      GoTo Continue
+    End If
+    
+    Call vsoShape.Delete
+    i = 1
+Continue:
+  Loop
+End Function
+
+Public Function CreateItemShape(term As TermItem, target As Visio.Page) As Visio.Shape
+  Dim res As Visio.Shape
+  If term.Basic Then
+    Set res = CreateShape(MASTER_BASIC, target)
+    res.Characters.Text = term.name_
+  Else
+    Set res = CreateShape(MASTER_DERIVED, target)
+    res.Shapes(S_D_TERM).Text = term.name_
+    res.Shapes(S_D_SOURCE).Text = term.source_
+    res.Shapes(S_D_DEFINITION).Text = term.definition_
+    
+    If InStr(term.definition_, Chr(13)) = 0 Then
+      res.Shapes(S_D_DEFINITION).CellsU("Width").FormulaU = "=MAX(50mm, TEXTWIDTH(TheText)*Char.Size*1.4/Height + 0.2in)"
+      res.CellsU("Width") = res.Shapes(S_D_SOURCE).CellsU("Width") + res.Shapes(S_D_DEFINITION).CellsU("Width")
+      res.Shapes(S_D_DEFINITION).CellsU("Width").FormulaU = "=Sheet." & CStr(res.ID) & "!Width - Sheet." & CStr(res.Shapes(S_D_SOURCE).ID) & "!Width"
+    End If
+  End If
+  Set CreateItemShape = res
+End Function
+
+Public Function CreateShape(sMaster$, iDestination As Visio.Page) As Visio.Shape
+  Set CreateShape = iDestination.Drop(FindMaster(iDestination.Document, sMaster), 0, 0)
+End Function
+
+Public Function AddTermTo(target As TermItem, iDestination As Visio.Page, iRank%)
+  Dim itemShape As Visio.Shape: Set itemShape = CreateItemShape(target, iDestination)
+  Dim rGrid As New RankGrid: Call rGrid.Init(iDestination)
+  
+  Dim baseX As Double: baseX = GetMostRightPos
+  If baseX = MOST_LEFT Then
+    baseX = iDestination.Shapes("SLevel1").CellsU("pinx") - iDestination.Shapes("SLevel1").CellsU("width") / 2#
+  End If
+  itemShape.CellsU("PinX") = baseX + itemShape.CellsU("Width") / 2#
+  
+  Call rGrid.MoveToRank(itemShape, iRank)
+  Call CenterScreenOnShape(itemShape)
+End Function
+
+Public Function PromptExcelData() As Collection
+  Dim sFileName$: sFileName = UserInteraction.PromptFileFilter( _
+                                sInitialPath:=ThisDocument.Path, _
+                                sDescription:="Excel file", _
+                                sFilter:="*.xls*;*.csv", _
+                                bNewApplication:=True)
+  If sFileName = "" Then _
+    Exit Function
+    
+  Dim wrap As New API_XLWrapper
+  If wrap.OpenDocument(sFileName) Is Nothing Then _
+    Exit Function
+  
+  Dim theData As Collection
+  Set theData = ScanExcel(wrap.Document.Worksheets(1))
+  If theData Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_INVALID_FILE_FORMAT)
+    Exit Function
+  End If
+  
+  Call wrap.ReleaseDocument
+  Set PromptExcelData = theData
+End Function
+
+Public Function Export2ExcelFrom(target As Visio.Page)
+  Dim templatePath$: templatePath = GetExportTemplate(XL_TEMPLATE_NAME)
+  Dim wrapper As New API_XLWrapper
+  Dim wb As Excel.Workbook: Set wb = wrapper.NewDocument(templatePath)
+  If wb Is Nothing Then _
+    Exit Function
+    
+  If templatePath = vbNullString Then
+    Call UserInteraction.ShowMessage(EM_TEMPLATE_MISSING)
+    Call wb.Sheets.Add
+    Call wb.Sheets.Add
+    Call wb.Sheets.Add
+    wb.Sheets(1).Name = XL_SHEET_SHAPES
+    wb.Sheets(2).Name = XL_SHEET_LINKS
+    wb.Sheets(3).Name = XL_SHEET_MENTIONS
+    wb.Sheets(4).Name = XL_SHEET_CYCLES
+  End If
+    
+  Call wrapper.PauseUI
+  
+  Dim helper As New Exporter:  Call helper.Init(wb)
+  Call helper.ScanDataFrom(target)
+  
+  Call wrapper.ResumeUI
+  Call Unload(CSE_ProgressBar)
+End Function
+  
+Public Function ExportComparison(iSource As Visio.Document, target As Visio.Document) As Boolean
+  ExportComparison = False
+  
+  Dim xlAppl As New API_XLWrapper
+  Dim outWB As Excel.Workbook: Set outWB = xlAppl.NewDocument
+  If outWB Is Nothing Then _
+    Exit Function
+    
+  Call xlAppl.PauseUI
+  
+  Call PrepareCompareOutput(outWB)
+  Dim Exporter As New ComparatorExporter: Call Exporter.Init(outWB)
+  Call Exporter.RunCompare(iSource.Pages(1), target.Pages(1))
+  Call FinalizeCompare(outWB)
+  
+  Call xlAppl.ResumeUI
+  
+  ExportComparison = True
+End Function
+
+Public Function BuildFromTerms(theData As Collection, ByRef baseCount&, ByRef termCount&)
+  Dim resPage As Visio.Page: Set resPage = ActivePage
+  
+  Dim basicWidth As Double: basicWidth = resPage.Document.Masters(MASTER_BASIC).Shapes(1).CellsU("Width")
+  Dim basicHeight As Double: basicHeight = resPage.Document.Masters(MASTER_BASIC).Shapes(1).CellsU("Height")
+  Dim derivedWidth As Double: derivedWidth = resPage.Document.Masters(MASTER_DERIVED).Shapes(1).Shapes(SHAPE_DERVIED).CellsU("Width")
+  Dim derivedHeight As Double: derivedHeight = resPage.Document.Masters(MASTER_DERIVED).Shapes(1).CellsU("Height")
+  
+  Dim basicX As Double: basicX = resPage.PageSheet.CellsU("XRulerOrigin") - BASE_START
+  Dim basicY As Double: basicY = resPage.PageSheet.CellsU("YRulerOrigin") - basicHeight / 2#
+  Dim derivedX As Double: derivedX = resPage.PageSheet.CellsU("XRulerOrigin")
+  Dim derivedY As Double: derivedY = resPage.PageSheet.CellsU("YRulerOrigin") + V_GAP
+  
+  Dim term As TermItem
+  Dim itemShape As Visio.Shape
+  Dim nItem&: nItem = 1: baseCount = 0: termCount = 0
+  Do While nItem <= theData.Count
+    Set term = theData.Item(nItem)
+    Set itemShape = CreateItemShape(term, resPage)
+    If itemShape Is Nothing Then _
+      GoTo NEXT_ITEM
+      
+    With itemShape
+      If term.Basic = True Then
+        itemShape.CellsU("PinX") = basicX - (BASIC_COLOMNS - 1 - baseCount Mod BASIC_COLOMNS) * (H_GAP + basicWidth) + itemShape.CellsU("Width") / 2#
+        itemShape.CellsU("PinY") = basicY - (baseCount \ BASIC_COLOMNS) * (V_GAP + basicHeight)
+        baseCount = baseCount + 1
+      Else
+        itemShape.CellsU("PinX") = derivedX + (termCount \ DERIVED_ROWS) * (H_GAP + derivedWidth) + itemShape.CellsU("Width") / 2#
+        itemShape.CellsU("PinY") = derivedY + (1 + (termCount Mod DERIVED_ROWS)) * (V_GAP + derivedHeight)
+        termCount = termCount + 1
+      End If
+    End With
+    
+NEXT_ITEM:
+    nItem = nItem + 1
+    Call CSE_ProgressBar.IncrementA
+  Loop
+End Function
+
+Public Function ScanAllTerms(target As Visio.Page) As Scripting.Dictionary
+  Dim iData As New Scripting.Dictionary
+  
+  Dim theType As ShapeType
+  Dim aShape As Visio.Shape
+  For Each aShape In target.Shapes
+    theType = GetShapeType(aShape)
+    If theType = STYPE_GRID Or theType = STYPE_UNKNOWN Then _
+      GoTo NEXT_SHAPE
+    If IsShapeDuplicate(aShape) Then _
+      GoTo NEXT_SHAPE
+    
+    Dim sText$
+    If theType = STYPE_DERIVED Then
+      sText = aShape.Shapes(S_D_TERM).Text
+    Else
+      sText = aShape.Text
+    End If
+    If sText <> "" Then _
+      sText = VBA.LCase(VBA.Left(sText, 1)) & VBA.Right(sText, VBA.Len(sText) - 1)
+    
+    If Not iData.Exists(sText) Then _
+      Set iData(sText) = aShape
+
+NEXT_SHAPE:
+  Next aShape
+  
+  Set ScanAllTerms = iData
+End Function
+
+' ==============
+Private Function CenterScreenOnShape(target As Visio.Shape)
+  Dim pinLeft As Double, pinTop As Double, pinWidth As Double, pinHeight As Double
+  Call Visio.Application.ActiveWindow.GetViewRect(pinLeft, pinTop, pinWidth, pinHeight)
+  Call Visio.Application.ActiveWindow.SetViewRect(target.CellsU("PinX") - pinWidth / 2#, _
+                          target.CellsU("PinY") + pinHeight / 2#, _
+                          pinWidth, pinHeight)
+End Function
+
+
+Private Function ScanExcel(dataSheet As Excel.Worksheet) As Collection
+' Extracting data from Excel
+  Dim result As New Collection
+    
+  Dim lstrow&:  lstrow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
+  Dim nRow&: nRow = 2
+  Dim newItem As TermItem
+  For nRow = 2 To lstrow
+    Set newItem = New TermItem
+    With newItem
+      .name_ = dataSheet.Cells(nRow, 1)
+      .definition_ = dataSheet.Cells(nRow, 2)
+      .source_ = dataSheet.Cells(nRow, 3)
+    End With
+    
+    Call result.Add(newItem)
+  Next nRow
+    
+  Set ScanExcel = result
+End Function
+
+Private Function PrepareCompareOutput(target As Excel.Workbook)
+  Call target.Sheets.Add
+  Call target.Sheets.Add
+  With target.Sheets(1)
+    .Name = "Source1"
+    .Cells(1, XL_TS_ID) = "ShapeID"
+    .Cells(1, XL_TS_NAME) = "Òåðìèí"
+    .Cells(1, XL_TS_DEFINITION) = "Îïðåäåëåíèå"
+    .Columns(XL_TS_NAME).ColumnWidth = 30
+    .Columns(XL_TS_DEFINITION).ColumnWidth = 60
+    .Rows(1).Font.Bold = True
+  End With
+  
+  With target.Sheets(2)
+    .Name = "Source2"
+    .Cells(1, XL_TS_ID) = "ShapeID"
+    .Cells(1, XL_TS_NAME) = "Òåðìèí"
+    .Cells(1, XL_TS_DEFINITION) = "Îïðåäåëåíèå"
+    .Columns(XL_TS_NAME).ColumnWidth = 30
+    .Columns(XL_TS_DEFINITION).ColumnWidth = 60
+    .Rows(1).Font.Bold = True
+  End With
+  
+  With target.Sheets(3)
+    .Name = "Compare"
+    .Cells(1, XL_COMP_1ST) = "Òîëüêî 1"
+    .Cells(1, XL_COMP_2ND) = "Òîëüêî 2"
+    .Cells(1, XL_COMP_SHARED) = "Ïåðåñå÷åíèå"
+    .Columns(XL_COMP_1ST).ColumnWidth = 30
+    .Columns(XL_COMP_2ND).ColumnWidth = 30
+    .Columns(XL_COMP_SHARED).ColumnWidth = 30
+    .Rows(1).Font.Bold = True
+  End With
+  
+  Dim ws As Excel.Worksheet
+  For Each ws In target.Worksheets
+    Call ws.Activate
+    With Excel.ActiveWindow
+      .SplitColumn = 0
+      .SplitRow = 1
+      .FreezePanes = True
+    End With
+  Next ws
+End Function
+
+Private Function FinalizeCompare(target As Excel.Workbook)
+  Call target.Sheets(1).Range("A:C").Sort(key1:=target.Sheets(1).Range("B1"), order1:=xlAscending, Header:=xlYes)
+  Call target.Sheets(2).Range("A:C").Sort(key1:=target.Sheets(2).Range("B1"), order1:=xlAscending, Header:=xlYes)
+  Call target.Sheets(3).Range("A:A").Sort(key1:=target.Sheets(3).Range("A1"), order1:=xlAscending, Header:=xlYes)
+  Call target.Sheets(3).Range("B:B").Sort(key1:=target.Sheets(3).Range("B1"), order1:=xlAscending, Header:=xlYes)
+  Call target.Sheets(3).Range("C:C").Sort(key1:=target.Sheets(3).Range("C1"), order1:=xlAscending, Header:=xlYes)
+End Function
+
+Private Function GetMostRightPos() As Double
+  GetMostRightPos = MOST_LEFT
+  
+  Dim aShape As Visio.Shape
+  Dim rightX As Double
+  For Each aShape In ActivePage.Shapes
+    If GetShapeType(aShape) = STYPE_GRID Then _
+      GoTo NEXT_SHAPE
+    rightX = aShape.CellsU("PinX") + aShape.CellsU("Width") / 2# + H_GAP
+    GetMostRightPos = IIf(rightX <= GetMostRightPos, GetMostRightPos, rightX)
+     
+NEXT_SHAPE:
+  Next aShape
+End Function

src/NewConcept.frm

@@ -0,0 +1,41 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} NewConcept 
+   ClientHeight    =   3915
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   6225
+   OleObjectBlob   =   "NewConcept.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "NewConcept"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCancelled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCancelled_ = True
+End Sub
+
+Private Sub OkBtn_Click()
+  isCancelled_ = False
+  Me.Hide
+End Sub
+
+Private Sub CancelBtn_Click()
+  isCancelled_ = True
+  Me.Hide
+End Sub
+
+Public Function GetTerm() As TermItem
+  Set GetTerm = New TermItem
+  With GetTerm
+    .name_ = Me.TermInput.Value
+    .definition_ = Me.NotionInput.Value
+    .source_ = Me.SourceInput.Value
+  End With
+End Function
+

src/RankGrid.cls

@@ -0,0 +1,211 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "RankGrid"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ====== Module for manipulating that grid ============
+Option Explicit
+
+Private lines_ As Collection
+Private page_ As Visio.Page
+Private rankHeight_ As Double
+
+Public Function Init(aPage As Visio.Page)
+  Set page_ = aPage
+  Call ScanShapes
+End Function
+
+Public Property Get Size() As Integer
+  Size = lines_.Count
+End Property
+
+Public Property Get Width() As Double
+  If lines_.Count = 0 Then _
+    Exit Function
+  Width = Abs(lines_(1).CellsU("BeginX") - lines_(1).CellsU("EndX"))
+End Property
+
+Public Function GetRankFor(target As Visio.Shape) As Integer
+  GetRankFor = RANK_UNREACHABLE
+  If lines_.Count = 0 Then _
+    Exit Function
+    
+  Dim yPos As Double: yPos = target.CellsU("PinY")
+  If yPos < lines_.Item(lines_.Count).CellsU("PinY") Then _
+    Exit Function
+  
+  Dim nGridShape%: nGridShape = 1
+  Dim iShape As Visio.Shape
+  For Each iShape In lines_
+    If yPos > iShape.CellsU("PinY") Then
+      GetRankFor = nGridShape - 1
+      Exit Function
+    End If
+    nGridShape = nGridShape + 1
+  Next iShape
+End Function
+
+Public Function CreateGrid(nCount%, dHeight As Double, dWidth As Double, dTopMargin As Double, dLeftMargin As Double)
+  Call DeleteGrid
+  If nCount < 1 Then _
+    Exit Function
+  
+  Dim dOriginX As Double: dOriginX = page_.PageSheet.CellsU("XGridOrigin") + dLeftMargin
+  Dim dEndX As Double: dEndX = dOriginX + dWidth
+  Dim dOriginY As Double: dOriginY = page_.PageSheet.CellsU("YGridOrigin") - dTopMargin
+  rankHeight_ = dHeight
+  
+  Dim nRank%
+  For nRank = 1 To nCount Step 1
+    Dim iLine As Visio.Shape: Set iLine = page_.Drop(FindMaster(page_.Document, MASTER_LEVEL), dOriginX, dOriginY)
+    Call lines_.Add(iLine)
+    With iLine
+      .CellsU("BeginX") = dOriginX
+      .CellsU("EndX") = dEndX
+      .CellsU("BeginY") = dOriginY - (nRank - 1) * rankHeight_
+      .CellsU("EndY") = .CellsU("BeginY")
+      .Name = PREFIX_GRID + CStr(nRank)
+    End With
+  Next nRank
+End Function
+
+Public Function DeleteGrid()
+  Dim iShape As Visio.Shape
+  For Each iShape In lines_
+    Call iShape.Delete
+  Next iShape
+  Set lines_ = New Collection
+End Function
+
+Public Function MoveUp(target As Visio.Shape) As Boolean
+  MoveUp = False
+  
+  Dim nRank%: nRank = GetRankFor(target)
+  If nRank = RANK_UNREACHABLE Then _
+    nRank = Size
+    
+  MoveUp = MoveToRank(target, nRank - 1)
+End Function
+
+Public Function MoveDown(target As Visio.Shape) As Boolean
+  MoveDown = False
+  
+  Dim nRank%: nRank = GetRankFor(target)
+  If nRank = RANK_UNREACHABLE Then _
+    Exit Function
+    
+  MoveDown = MoveToRank(target, nRank + 1)
+End Function
+
+Public Function MoveToRank(target As Visio.Shape, nRank%) As Boolean
+  MoveToRank = False
+  If nRank > RANK_MAX Or nRank < 0 Then _
+    Exit Function
+  If Size() = 0 Then _
+    Exit Function
+  MoveToRank = True
+  
+  If nRank = 0 Then
+    target.CellsU("PinY") = lines_.Item(1).CellsU("PinY") + V_GAP + target.CellsU("Height") / 2#
+    Exit Function
+  End If
+  
+  Do While nRank + 1 > lines_.Count
+    Dim newShape As Visio.Shape: Set newShape = CreateShape(MASTER_LEVEL, page_)
+    Dim prevLine As Visio.Shape: Set prevLine = lines_.Item(lines_.Count)
+    Call lines_.Add(newShape)
+    With newShape
+      .CellsU("BeginX") = prevLine.CellsU("BeginX")
+      .CellsU("EndX") = prevLine.CellsU("EndX")
+      .CellsU("BeginY") = prevLine.CellsU("BeginY") - rankHeight_
+      .CellsU("EndY") = prevLine.CellsU("EndY") - rankHeight_
+      .Name = GetNextLineName
+    End With
+  Loop
+  
+  target.CellsU("PinY") = (lines_.Item(nRank + 1).CellsU("PinY") + lines_.Item(nRank).CellsU("PinY")) / 2#
+End Function
+
+Public Function IncrementWidth(dIncrement As Double) As Boolean
+  IncrementWidth = False
+  
+  If lines_.Count = 0 Then _
+    Exit Function
+  If dIncrement = 0 Then
+    IncrementWidth = True
+    Exit Function
+  End If
+  
+  Dim bFirst As Boolean: bFirst = True
+  Dim dBeginX As Double
+  Dim dWidth As Double
+  Dim iLine As Visio.Shape
+  For Each iLine In lines_
+    If bFirst Then
+      bFirst = False
+      dWidth = Abs(iLine.CellsU("BeginX") - iLine.CellsU("EndX")) + dIncrement
+      If dWidth < 0 Then _
+        Exit Function
+      dBeginX = iLine.CellsU("BeginX")
+    End If
+    
+    iLine.CellsU("BeginX") = dBeginX
+    iLine.CellsU("EndX") = dBeginX + dWidth
+  Next iLine
+  
+  IncrementWidth = True
+End Function
+
+' =============
+Private Function ScanShapes()
+  Set lines_ = New Collection
+  Dim iLines As Collection: Set iLines = GetGridLines
+  If iLines.Count < 2 Then _
+    Exit Function
+  
+  Dim iShape As Visio.Shape
+  Do While iLines.Count <> 0
+    Dim curMax As Double: curMax = -999999
+    Dim nMax&: nMax = -1
+    Dim nItem&: nItem = 1
+    For Each iShape In iLines
+      If curMax < iShape.CellsU("PinY") Then
+        nMax = nItem
+        curMax = iShape.CellsU("PinY")
+      End If
+      nItem = nItem + 1
+    Next iShape
+    
+    Call lines_.Add(iLines.Item(nMax))
+    Call iLines.Remove(nMax)
+  Loop
+  
+  rankHeight_ = Abs(lines_.Item(lines_.Count).CellsU("PinY") - lines_.Item(lines_.Count - 1).CellsU("PinY"))
+End Function
+
+Private Function GetGridLines() As Collection
+  Dim iLines As New Collection
+  Dim iShape As Visio.Shape
+  For Each iShape In page_.Shapes
+    If iShape.Name Like MASK_LEVEL Then _
+      Call iLines.Add(iShape)
+  Next iShape
+  Set GetGridLines = iLines
+End Function
+
+Private Function GetNextLineName() As String
+  Dim nLine%: nLine = lines_.Count
+  Dim sName$
+  Do While True
+    sName = PREFIX_GRID & nLine
+    If Not VsoShapeExists(sName, page_) Then
+      GetNextLineName = sName
+      Exit Function
+    End If
+    nLine = nLine + 1
+  Loop
+End Function

src/TermItem.cls

@@ -0,0 +1,19 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "TermItem"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public name_ As String
+Public definition_ As String
+Public source_ As String
+
+Property Get Basic() As Boolean
+  Basic = definition_ = ""
+End Property
+

src/ThisDocument.cls

@@ -0,0 +1,21 @@
+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/s_RankGrid.cls

@@ -0,0 +1,251 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_RankGrid"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private page_ As Visio.Page
+Private grid_ As RankGrid
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set page_ = ThisDocument.Pages.Add
+  Set grid_ = New RankGrid: Call grid_.Init(page_)
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function3
+  Call page_.Delete(0)
+End Function
+
+Public Function t_Access()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim theGrid As New RankGrid
+  Dim iElement As Visio.Shape: Set iElement = page_.Drop(FindMaster(ThisDocument, MASTER_BASIC), 0, 0)
+  
+  Call Dev_NewCase("No grid")
+  Call theGrid.Init(page_)
+  Call Dev_ExpectEQ(0, theGrid.Size)
+  Call Dev_ExpectEQ(RANK_UNREACHABLE, theGrid.GetRankFor(iElement))
+  
+  Call Dev_NewCase("Custom grid")
+  Dim iLine1 As Visio.Shape: Set iLine1 = page_.Drop(FindMaster(ThisDocument, MASTER_LEVEL), 0, 5)
+  iLine1.Name = PREFIX_GRID & "1"
+  Dim iLine2 As Visio.Shape: Set iLine2 = page_.Drop(FindMaster(ThisDocument, MASTER_LEVEL), 0, -5)
+  iLine2.Name = PREFIX_GRID & "2"
+  Call theGrid.Init(page_)
+  Call Dev_ExpectEQ(2, theGrid.Size)
+  
+  Call Dev_NewCase("Ranks")
+  Call Dev_ExpectEQ(1, theGrid.GetRankFor(iElement), "Mid")
+  iElement.CellsU("PinY") = 15
+  Call Dev_ExpectEQ(0, theGrid.GetRankFor(iElement), "Top")
+  iElement.CellsU("PinY") = -15
+  Call Dev_ExpectEQ(RANK_UNREACHABLE, theGrid.GetRankFor(iElement), "Bottom")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_CreateGrid()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Invalid rank")
+  On Error Resume Next
+  Call grid_.CreateGrid(0, 10, 30, 1, 1)
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  Call Dev_ExpectEQ(0, page_.Shapes.Count, "Do not create anything")
+  
+  Call Dev_NewCase("Valid grid")
+  Call grid_.CreateGrid(3, dHeight:=10, dWidth:=30, dTopMargin:=1, dLeftMargin:=2)
+  Call Dev_ExpectEQ(3, page_.Shapes.Count, "Shapes count")
+  Call Dev_ExpectAEQ(10, page_.Shapes("SLevel1").CellsU("PinY") - page_.Shapes.Item("SLevel2").CellsU("PinY"), 2, "Height")
+  Call Dev_ExpectAEQ(30, page_.Shapes("SLevel1").CellsU("Width"), 2, "Width")
+  Call Dev_ExpectAEQ(grid_.Width, page_.Shapes("SLevel1").CellsU("Width"), 2, "Width")
+  Call Dev_ExpectAEQ(-1, page_.Shapes("SLevel1").CellsU("PinY") - page_.PageSheet.CellsU("YGridOrigin"), 2, "Top Margin")
+  Call Dev_ExpectAEQ(2, page_.Shapes("SLevel1").CellsU("BeginX") - page_.PageSheet.CellsU("XGridOrigin"), 2, "Left Margin")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_DeleteGrid()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iElement As Visio.Shape: Set iElement = page_.Drop(FindMaster(ThisDocument, MASTER_BASIC), 0, 0)
+  Dim nID&: nID = iElement.ID
+  
+  Call Dev_NewCase("No grid")
+  On Error Resume Next
+  Call grid_.DeleteGrid
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  Call Dev_ExpectEQ(1, page_.Shapes.Count, "Do not remove existing shapes")
+  
+  Call Dev_NewCase("Valid grid")
+  Call grid_.CreateGrid(3, dHeight:=10, dWidth:=30, dTopMargin:=1, dLeftMargin:=2)
+  Call grid_.DeleteGrid
+  Call Dev_ExpectEQ(1, page_.Shapes.Count, "Shapes count")
+  Call Dev_ExpectEQ(nID, page_.Shapes(1).ID)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_MoveShape()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iElement As Visio.Shape: Set iElement = page_.Drop(FindMaster(ThisDocument, MASTER_BASIC), 0, 0)
+  
+  Call Dev_NewCase("No grid")
+  On Error Resume Next
+  Call Dev_ExpectFalse(grid_.MoveToRank(iElement, 0))
+  Call Dev_ExpectNoError
+  Call Dev_ExpectFalse(grid_.MoveUp(iElement))
+  Call Dev_ExpectNoError
+  Call Dev_ExpectFalse(grid_.MoveDown(iElement))
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call grid_.CreateGrid(3, dHeight:=10, dWidth:=30, dTopMargin:=1, dLeftMargin:=2)
+  Dim iLevel1 As Visio.Shape: Set iLevel1 = page_.Shapes("SLevel1")
+  Dim iLevel2 As Visio.Shape: Set iLevel2 = page_.Shapes("SLevel2")
+  Dim iLevel3 As Visio.Shape: Set iLevel3 = page_.Shapes("SLevel3")
+  
+  Call Dev_NewCase("Move valid")
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 0))
+  Call Dev_ExpectEQ(0, grid_.GetRankFor(iElement))
+  Call Dev_ExpectGR(iElement.CellsU("PinY"), iLevel1.CellsU("PinY"))
+
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 1))
+  Call Dev_ExpectEQ(1, grid_.GetRankFor(iElement))
+  Call Dev_ExpectLS(iElement.CellsU("PinY"), iLevel1.CellsU("PinY"))
+  Call Dev_ExpectGR(iElement.CellsU("PinY"), iLevel2.CellsU("PinY"))
+  
+  Call Dev_ExpectTrue(grid_.MoveUp(iElement))
+  Call Dev_ExpectEQ(0, grid_.GetRankFor(iElement))
+  Call Dev_ExpectFalse(grid_.MoveUp(iElement))
+  Call Dev_ExpectTrue(grid_.MoveDown(iElement))
+  Call Dev_ExpectEQ(1, grid_.GetRankFor(iElement))
+  
+  
+  Call Dev_NewCase("Move from top")
+  iElement.Cells("PinY") = 100
+  Call Dev_ExpectEQ(0, grid_.GetRankFor(iElement))
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 2), "MoveTo")
+  Call Dev_ExpectEQ(2, grid_.GetRankFor(iElement), "MoveTo")
+  
+  iElement.Cells("PinY") = 100
+  Call Dev_ExpectFalse(grid_.MoveUp(iElement), "Move up")
+  Call Dev_ExpectEQ(0, grid_.GetRankFor(iElement), "Move up")
+  
+  iElement.Cells("PinY") = 100
+  Call Dev_ExpectTrue(grid_.MoveDown(iElement), "Move down")
+  Call Dev_ExpectEQ(1, grid_.GetRankFor(iElement), "Move down")
+  
+  Call Dev_NewCase("Move from bottom")
+  iElement.Cells("PinY") = -100
+  Call Dev_ExpectEQ(RANK_UNREACHABLE, grid_.GetRankFor(iElement))
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 2), "MoveTo")
+  Call Dev_ExpectEQ(2, grid_.GetRankFor(iElement), "MoveTo")
+  
+  iElement.Cells("PinY") = -100
+  Call Dev_ExpectTrue(grid_.MoveUp(iElement), "Move up")
+  Call Dev_ExpectEQ(2, grid_.GetRankFor(iElement), "Move up")
+  
+  iElement.Cells("PinY") = -100
+  Call Dev_ExpectFalse(grid_.MoveDown(iElement), "Move down")
+  Call Dev_ExpectEQ(RANK_UNREACHABLE, grid_.GetRankFor(iElement), "Move down")
+  
+  Call Dev_NewCase("Create additional levels")
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 2))
+  Call Dev_ExpectTrue(grid_.MoveDown(iElement), "Move down")
+  Call Dev_ExpectEQ(3, grid_.GetRankFor(iElement), "Move down")
+  Call Dev_ExpectEQ(4, grid_.Size, "Move down")
+  
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 6), "Move to")
+  Call Dev_ExpectEQ(6, grid_.GetRankFor(iElement), "Move to")
+  Call Dev_ExpectEQ(7, grid_.Size, "Move to")
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, RANK_MAX), "Max rank")
+  Call Dev_ExpectFalse(grid_.MoveDown(iElement), "Max rank")
+  Call Dev_ExpectFalse(grid_.MoveToRank(iElement, RANK_MAX + 1), "Max rank")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_CustomGrid()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iElement As Visio.Shape: Set iElement = page_.Drop(FindMaster(ThisDocument, MASTER_BASIC), 0, 0)
+  Call grid_.CreateGrid(3, dHeight:=10, dWidth:=30, dTopMargin:=1, dLeftMargin:=2)
+  Dim iLevel1 As Visio.Shape: Set iLevel1 = page_.Shapes("SLevel1")
+  Dim iLevel2 As Visio.Shape: Set iLevel2 = page_.Shapes("SLevel2")
+  Dim iLevel3 As Visio.Shape: Set iLevel3 = page_.Shapes("SLevel3")
+  
+  iLevel1.CellsU("BeginY") = -10
+  iLevel1.CellsU("EndY") = -10
+  iLevel3.CellsU("BeginY") = 10
+  iLevel3.CellsU("EndY") = 10
+  Call iLevel2.Delete
+  
+  Call grid_.Init(page_)
+  
+  Call Dev_ExpectEQ(2, grid_.Size, "Grid size")
+  Call Dev_ExpectTrue(grid_.MoveToRank(iElement, 1), "Valid move")
+  Call Dev_ExpectEQ(1, grid_.GetRankFor(iElement), "Valid move")
+  Call Dev_ExpectLS(iElement.CellsU("PinY"), iLevel3.CellsU("PinY"), "Level ordering")
+  Call Dev_ExpectGR(iElement.CellsU("PinY"), iLevel1.CellsU("PinY"), "Level ordering")
+  
+  Call Dev_NewCase("Add level")
+  Call Dev_ExpectTrue(grid_.MoveDown(iElement), "Move down")
+  Call Dev_ExpectEQ(2, grid_.GetRankFor(iElement), "Move down")
+  Call Dev_ExpectEQ(3, grid_.Size, "Move down")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ChangeWidth()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("No grid")
+  On Error Resume Next
+  Call Dev_ExpectFalse(grid_.IncrementWidth(10))
+  Call Dev_ExpectNoError
+  Call Dev_ExpectFalse(grid_.IncrementWidth(-10))
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call grid_.CreateGrid(3, dHeight:=10, dWidth:=30, dTopMargin:=1, dLeftMargin:=2)
+  Dim iLevel1 As Visio.Shape: Set iLevel1 = page_.Shapes("SLevel1")
+  Dim iLevel2 As Visio.Shape: Set iLevel2 = page_.Shapes("SLevel2")
+  Dim iLevel3 As Visio.Shape: Set iLevel3 = page_.Shapes("SLevel3")
+  iLevel2.CellsU("BeginX") = 10
+  
+  Call Dev_NewCase("Valid grid")
+  Call Dev_ExpectTrue(grid_.IncrementWidth(10))
+  Call Dev_ExpectAEQ(iLevel1.CellsU("BeginX"), iLevel2.CellsU("BeginX"), 2, "Alignment")
+  Call Dev_ExpectAEQ(40, grid_.Width, 2, "Expand Width")
+  Call Dev_ExpectTrue(grid_.IncrementWidth(-10))
+  Call Dev_ExpectAEQ(30, grid_.Width, 2, "Shrink Width")
+  
+  Call Dev_NewCase("Invalid increment")
+  Call Dev_ExpectFalse(grid_.IncrementWidth(-1000))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/z_UIMessages.bas

@@ -0,0 +1,71 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_INVALID_LEVEL
+  EM_EMPTY_SELECTION
+  EM_INVALID_FILE_FORMAT
+  EM_TEMPLATE_MISSING
+  EM_INVALID_WIDTH
+  EM_PYTHON_ERROR
+  
+  IM_GENEARION_COMPLETE
+  IM_EXPORT_DIFF_COMPLETE
+  IM_EXPORT_XL_COMPLETE
+
+  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_INVALID_LEVEL:          Call MsgBox("Íåêîððåêòíûé íîìåð óðîâíÿ", vbExclamation)
+  Case EM_EMPTY_SELECTION:        Call MsgBox("Äëÿ îïåðàöèè íåîáõîäèìî âûäåëèòü ÷òî-òî!", vbExclamation)
+  Case EM_INVALID_FILE_FORMAT:    Call MsgBox("Invalid file format", vbExclamation)
+  Case EM_TEMPLATE_MISSING:       Call MsgBox("Íå óäàëîñü íàéòè øàáëîí. Áóäåò ñîçäàí ïóñòîé äîêóìåíò", vbExclamation)
+  Case EM_INVALID_WIDTH:          Call MsgBox("Íåêîððåêòíàÿ øèðèíà óðîâíÿ", vbExclamation)
+  Case EM_PYTHON_ERROR:           Call MsgBox(Fmt("Python error: {1}", unwrapped), vbInformation)
+  
+  Case IM_GENEARION_COMPLETE:     Call MsgBox(Fmt("Ïîñòðîåíèå çàâåðøåíî!" & vbNewLine & _
+                                                  "Âñåãî áàçîâûõ ïîíÿòèé: {1}" & vbNewLine & _
+                                                  "Âñåãî âûâîäèìûé ïîíÿòèé: {2}", unwrapped), vbInformation)
+  Case IM_EXPORT_DIFF_COMPLETE:   Call MsgBox("Âûãðóçêà ñðàâíåíèÿ çàâåðøåíà", vbInformation)
+  Case IM_EXPORT_XL_COMPLETE:     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,33 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+
+Sub OnAction(control As IRibbonControl)
+  Select Case control.ID
+    Case "ImportExcel":       Call RunImportExcel
+    Case "AddNotion":         Call RunAddNotion
+    
+    Case "AddGrid":           Call RunAddGrid
+    Case "DeleteGrid":        Call RunDeleteGrid
+    
+    Case "Plus10":            Call RunGridPlus10
+    Case "Minus10":           Call RunGridMinus10
+    Case "DeltaX":            Call RunGridChange
+    
+    Case "TopAlignment":      Call CC_TopAlignment
+    Case "LeftAlignment":     Call CC_LeftAlignment
+    
+    Case "MoveUp":            Call RunMoveUp
+    Case "MoveDown":          Call RunMoveDown
+    Case "MoveX":             Call RunMoveToX
+    
+    Case "ExpandStraight":    Call CC_ExpandStraight
+    Case "ExpandReverse":     Call CC_ExpandReverse
+    Case "GotoLinkBegin":     Call CC_GotoLinkBegin
+    Case "GotoLinkEnd":       Call CC_GotoLinkEnd
+    
+    Case "ExportExcel":       Call RunExportExcel
+    Case "CompareTo":         Call RunCompare
+    Case "CleanUp":           Call RunCleanUp
+    Case "Help":              Call RunHelp
+  End Select
+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,128 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
+	<ribbon>
+	<tabs>
+	<tab id="TermMap" label="Концепт.Определения">
+	<group id="Defs.Actions" label="Действия">
+		<button id="ImportExcel" size="large"
+			label="Excel"
+			supertip="Загрузка Реестра из Excel"
+			imageMso="FileSaveAsExcelXlsx"
+			onAction="OnAction"/>
+		<button id="AddNotion" size="large"
+			label="Новое понятие"
+			supertip="Добавить новое понятие"
+			imageMso="QueryAppend"
+			onAction="OnAction"/>
+						
+		<button id="AddGrid" size="large"
+			label="Создать уровни"
+			supertip="Создать линии уровней на листе"
+			imageMso="ViewGridlinesFrontPage"
+			onAction="OnAction"/>
+		<button id="DeleteGrid" size="large"
+			label="Удалить уровни"
+			supertip="Удалить линии уровней"
+			imageMso="ClearGrid"
+			onAction="OnAction"/>
+		
+		<button id="Plus10"
+			label="+10см"
+			supertip="Увеличить длину линий уровня на 10 см"
+			imageMso="OutlineSubtasksShow"
+			onAction="OnAction"/>
+		<button id="Minus10"
+			label="-10см"
+			supertip="Уменьшить длину линий уровня на 10 см"
+			imageMso="OutlineSubtasksHide"
+			onAction="OnAction"/>
+		<button id="DeltaX"
+			label="+/- X"
+			supertip="Изменить длину линий уровня на X см"
+			imageMso="ConnectionPointTool"
+			onAction="OnAction"/>
+				
+		<button id="TopAlignment" size="large"
+			label="Выровнять верх"
+			supertip="Выровнять строки по верхнеиу краю"
+			imageMso="ObjectsAlignTopSmart"
+			onAction="OnAction"/>
+		<button id="LeftAlignment" size="large"
+			label="Выровнять лево"
+			supertip="Выровнять колонны по левому краю"
+			imageMso="ObjectsAlignLeftSmart"
+			onAction="OnAction"/>
+				
+		<separator id="sep1"/>		
+				
+		<button id="MoveUp" keytip="Q"
+			label="Вверх"
+			supertip="Переместить на ранг ниже [Ctrl+Q]"
+			imageMso="FontSizeIncrease"
+			onAction="OnAction"/>
+		<button id="MoveDown" keytip="E"
+			label="Вниз"
+			supertip="Переместить на ранг выше [Ctrl+E]"
+			imageMso="FontSizeDecrease"
+			onAction="OnAction"/>
+		<button id="MoveX"
+			label="Ранг"
+			supertip="Переместить на заданный ранг"
+			imageMso="ChangeStylesMenu"
+			onAction="OnAction"/>
+	</group>
+	
+	<group id="Defs.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="Defs.Misc" label="Дополнительно">
+		<button id="ExportExcel" size="large"
+			label="Выгрузить Excel"
+			supertip="Выгрузить данные карты в Excel"
+			onAction="OnAction"
+			imageMso="ExportExcel"/>
+		<button id="CompareTo" size="large"
+			label="Сравнить"
+			supertip="Выгрузить описание сравнения двух карт понятий"
+			onAction="OnAction"
+			imageMso="VisioDiagramGallery"/>
+		<button id="CleanUp" size="large"
+			label="Очистка"
+			supertip="Очистка схемы"
+			imageMso="TableDeleteRowsAndColumnsMenuWord"
+			onAction="OnAction"/>
+		<button id="Help" size="large"
+			label="Справка"
+			supertip="Вызов справки"
+			onAction="OnAction"
+			imageMso="Info"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>