Initial commit
This commit is contained in:
IRBorisov
commit
b86c5015bc
40
VBAMake.txt
Normal file
40
VBAMake.txt
Normal file
|
|
@ -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
|
||||
BIN
distr/!Руководство пользователя.docx
Normal file
BIN
distr/!Руководство пользователя.docx
Normal file
Binary file not shown.
BIN
distr/Определения-Excel.xltx
Normal file
BIN
distr/Определения-Excel.xltx
Normal file
Binary file not shown.
BIN
distr/Пример входных данных.xlsx
Normal file
BIN
distr/Пример входных данных.xlsx
Normal file
Binary file not shown.
BIN
distr/Руководство по нотации.vsdx
Normal file
BIN
distr/Руководство по нотации.vsdx
Normal file
Binary file not shown.
96
script/manifest.txt
Normal file
96
script/manifest.txt
Normal file
|
|
@ -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
|
||||
BIN
skeleton/Карта понятий.vsdm
Normal file
BIN
skeleton/Карта понятий.vsdm
Normal file
Binary file not shown.
83
src/ComparatorExporter.cls
Normal file
83
src/ComparatorExporter.cls
Normal file
|
|
@ -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
|
||||
150
src/Declarations.bas
Normal file
150
src/Declarations.bas
Normal file
|
|
@ -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
|
||||
|
||||
22
src/DevHelper.bas
Normal file
22
src/DevHelper.bas
Normal file
|
|
@ -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
|
||||
259
src/Exporter.cls
Normal file
259
src/Exporter.cls
Normal file
|
|
@ -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
|
||||
|
||||
45
src/GridDlg.frm
Normal file
45
src/GridDlg.frm
Normal file
|
|
@ -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
|
||||
|
||||
BIN
src/GridDlg.frx
Normal file
BIN
src/GridDlg.frx
Normal file
Binary file not shown.
323
src/Main.bas
Normal file
323
src/Main.bas
Normal file
|
|
@ -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
|
||||
296
src/MainImpl.bas
Normal file
296
src/MainImpl.bas
Normal file
|
|
@ -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
|
||||
41
src/NewConcept.frm
Normal file
41
src/NewConcept.frm
Normal file
|
|
@ -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
|
||||
|
||||
BIN
src/NewConcept.frx
Normal file
BIN
src/NewConcept.frx
Normal file
Binary file not shown.
211
src/RankGrid.cls
Normal file
211
src/RankGrid.cls
Normal file
|
|
@ -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
|
||||
19
src/TermItem.cls
Normal file
19
src/TermItem.cls
Normal file
|
|
@ -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
|
||||
|
||||
21
src/ThisDocument.cls
Normal file
21
src/ThisDocument.cls
Normal file
|
|
@ -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
|
||||
251
src/s_RankGrid.cls
Normal file
251
src/s_RankGrid.cls
Normal file
|
|
@ -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
|
||||
71
src/z_UIMessages.bas
Normal file
71
src/z_UIMessages.bas
Normal file
|
|
@ -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
|
||||
33
src/z_UIRibbon.bas
Normal file
33
src/z_UIRibbon.bas
Normal file
|
|
@ -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
|
||||
2
ui/.rels
Normal file
2
ui/.rels
Normal file
|
|
@ -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>
|
||||
128
ui/customUI1.xml
Normal file
128
ui/customUI1.xml
Normal file
|
|
@ -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>
|
||||
Loading…
Reference in New Issue
Block a user