Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
S
StarUML Evológica Plugin
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
3
Merge Requests
3
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Registry
Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
evologica
StarUML Evológica Plugin
Commits
1a931289
Commit
1a931289
authored
Sep 18, 2020
by
Jucelino Fonseca
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Ajustes, criação do filtro
parent
c12f432b
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
87 additions
and
44 deletions
+87
-44
ituExplorerV2.dfm
EvoUMLPlugin/src/ituExplorerV2.dfm
+33
-26
ituExplorerV2.pas
EvoUMLPlugin/src/ituExplorerV2.pas
+54
-18
No files found.
EvoUMLPlugin/src/ituExplorerV2.dfm
View file @
1a931289
...
@@ -11754,7 +11754,7 @@ object ExplorerV2: TExplorerV2
...
@@ -11754,7 +11754,7 @@ object ExplorerV2: TExplorerV2
OnDragDrop = memOQLQuery2DragDrop
OnDragDrop = memOQLQuery2DragDrop
OnDragOver = memOQLQuery2DragOver
OnDragOver = memOQLQuery2DragOver
BorderStyle = bsNone
BorderStyle = bsNone
Gutter.Width =
29
Gutter.Width =
42
Gutter.MouseActions = <>
Gutter.MouseActions = <>
RightGutter.Width = 0
RightGutter.Width = 0
RightGutter.MouseActions = <>
RightGutter.MouseActions = <>
...
@@ -12941,8 +12941,8 @@ object ExplorerV2: TExplorerV2
...
@@ -12941,8 +12941,8 @@ object ExplorerV2: TExplorerV2
TabOrder = 1
TabOrder = 1
object tvModelExplorer: TTreeView
object tvModelExplorer: TTreeView
Left = 0
Left = 0
Height = 7
19
Height = 7
51
Top = 1
52
Top = 1
20
Width = 450
Width = 450
Align = alClient
Align = alClient
BorderStyle = bsNone
BorderStyle = bsNone
...
@@ -12968,51 +12968,43 @@ object ExplorerV2: TExplorerV2
...
@@ -12968,51 +12968,43 @@ object ExplorerV2: TExplorerV2
end
end
object pnFiltroClasse: TPanel
object pnFiltroClasse: TPanel
Left = 0
Left = 0
Height = 1
52
Height = 1
20
Top = 0
Top = 0
Width = 450
Width = 450
Align = alTop
Align = alTop
ClientHeight = 1
52
ClientHeight = 1
20
ClientWidth = 450
ClientWidth = 450
TabOrder = 1
TabOrder = 1
object edtClasse: TEdit
object edtClasse: TEdit
Left = 11
Left = 11
Height = 28
Height = 28
Top =
101
Top =
83
Width = 419
Width = 419
OnChange = edtClasseChange
OnChange = edtClasseChange
TabOrder = 0
TabOrder = 0
end
end
object
Label1: TLabel
object
gbAgrupamento: TGroupBox
Left = 11
Left = 11
Height = 20
Height = 56
Top = 80
Top = 3
Width = 31
Width = 419
Caption = 'Class'
Caption = 'Group'
ClientHeight = 31
ClientWidth = 415
Font.CharSet = ANSI_CHARSET
Font.CharSet = ANSI_CHARSET
Font.Color = clBlack
Font.Color = clBlack
Font.Height = -15
Font.Height = -15
Font.Name = 'Segoe UI
Light
'
Font.Name = 'Segoe UI'
Font.Pitch = fpVariable
Font.Pitch = fpVariable
Font.Quality = fqDraft
Font.Quality = fqDraft
ParentColor = False
ParentFont = False
ParentFont = False
end
object gbAgrupamento: TGroupBox
Left = 11
Height = 64
Top = 16
Width = 419
Caption = 'Agrupamento'
ClientHeight = 39
ClientWidth = 415
TabOrder = 1
TabOrder = 1
object rbHieraquia: TRadioButton
object rbHieraquia: TRadioButton
Left = 200
Left = 200
Height = 24
Height = 24
Top = 0
Top = 0
Width = 8
9
Width = 8
7
Caption = 'Hiera
quia
'
Caption = 'Hiera
rchy
'
OnClick = edtClasseChange
OnClick = edtClasseChange
TabOrder = 0
TabOrder = 0
end
end
...
@@ -13020,14 +13012,29 @@ object ExplorerV2: TExplorerV2
...
@@ -13020,14 +13012,29 @@ object ExplorerV2: TExplorerV2
Left = 16
Left = 16
Height = 24
Height = 24
Top = 0
Top = 0
Width =
96
Width =
48
Caption = '
Sequencial
'
Caption = '
Flat
'
Checked = True
Checked = True
OnClick = edtClasseChange
OnClick = edtClasseChange
TabOrder = 1
TabOrder = 1
TabStop = True
TabStop = True
end
end
end
end
object Label2: TLabel
Left = 15
Height = 20
Top = 61
Width = 33
Caption = 'Class'
Font.CharSet = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Name = 'Segoe UI'
Font.Pitch = fpVariable
Font.Quality = fqDraft
ParentColor = False
ParentFont = False
end
end
end
end
end
object il1: TImageList
object il1: TImageList
...
...
EvoUMLPlugin/src/ituExplorerV2.pas
View file @
1a931289
...
@@ -29,7 +29,7 @@ type
...
@@ -29,7 +29,7 @@ type
edtClasse
:
TEdit
;
edtClasse
:
TEdit
;
gbAgrupamento
:
TGroupBox
;
gbAgrupamento
:
TGroupBox
;
ilModel
:
TImageList
;
ilModel
:
TImageList
;
Label
1
:
TLabel
;
Label
2
:
TLabel
;
lvXMLListResult
:
TListView
;
lvXMLListResult
:
TListView
;
memXMLTextResult
:
TMemo
;
memXMLTextResult
:
TMemo
;
OQLObjects
:
TObjectExplorer
;
OQLObjects
:
TObjectExplorer
;
...
@@ -118,7 +118,7 @@ type
...
@@ -118,7 +118,7 @@ type
function
GetStringEntreParenteses
(
piString
:
string
)
:
string
;
function
GetStringEntreParenteses
(
piString
:
string
)
:
string
;
function
GetNumeroDeStringOID
(
piString
:
string
)
:
string
;
function
GetNumeroDeStringOID
(
piString
:
string
)
:
string
;
procedure
CopiaTextoObjeto
(
piObjeto
:
TTreeNode
);
procedure
CopiaTextoObjeto
(
piObjeto
:
TTreeNode
);
function
BuscaParcialClasse
(
piCLasse
:
string
;
pi
ItemPai
:
TTreeNode
;
pi
Filtrar
:
boolean
):
boolean
;
function
BuscaParcialClasse
(
piCLasse
:
string
;
piFiltrar
:
boolean
):
boolean
;
protected
protected
procedure
CreateParams
(
var
Params
:
TCreateParams
);
override
;
procedure
CreateParams
(
var
Params
:
TCreateParams
);
override
;
function
Connect
:
acPersistenceSession
;
function
Connect
:
acPersistenceSession
;
...
@@ -520,8 +520,7 @@ begin
...
@@ -520,8 +520,7 @@ begin
Clipbrd
.
Clipboard
.
AsText
:=
lString
;
Clipbrd
.
Clipboard
.
AsText
:=
lString
;
end
;
end
;
function
TExplorerV2
.
BuscaParcialClasse
(
piCLasse
:
string
;
function
TExplorerV2
.
BuscaParcialClasse
(
piCLasse
:
string
;
piFiltrar
:
boolean
):
boolean
;
piItemPai
:
TTreeNode
;
piFiltrar
:
boolean
):
boolean
;
var
lClasseTree
,
var
lClasseTree
,
lClasseP
:
string
;
lClasseP
:
string
;
begin
begin
...
@@ -590,7 +589,7 @@ begin
...
@@ -590,7 +589,7 @@ begin
while
not
lEnumerator
.
EOL
do
while
not
lEnumerator
.
EOL
do
begin
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
Node
,
lFiltro
)
then
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
lFiltro
)
then
begin
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
.
ImageIndex
:=
6
;
targetNode
.
ImageIndex
:=
6
;
...
@@ -685,33 +684,71 @@ var lClassTicket: acClassTicket;
...
@@ -685,33 +684,71 @@ var lClassTicket: acClassTicket;
lCardinality
:
string
;
lCardinality
:
string
;
lEnumerator
:
acEnumerator
;
lEnumerator
:
acEnumerator
;
li
:
integer
;
li
:
integer
;
lNodeParent
,
targetNode
:
TTreeNode
;
targetNode
:
TTreeNode
;
lFiltro
:
boolean
;
lFiltro
:
boolean
;
begin
begin
lFiltro
:=
trim
(
edtClasse
.
Text
)
<>
''
;
lFiltro
:=
trim
(
edtClasse
.
Text
)
<>
''
;
if
Node
.
HasChildren
and
(
Node
.
Count
=
0
)
then
if
Node
.
HasChildren
{and (Node.Count = 0)}
then
begin
begin
Node
.
Owner
.
BeginUpdate
;
Node
.
Owner
.
BeginUpdate
;
try
try
if
(
TObject
(
Node
.
Data
)
is
acMetaModel
)
then
if
(
TObject
(
Node
.
Data
)
is
acMetaModel
)
then
begin
begin
//Carregas o pai
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
try
while
not
lEnumerator
.
EOL
do
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
if
not
Assigned
(
lClassTicket
.
ParentClassTicket
)
then
begin
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
lFiltro
)
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
.
ImageIndex
:=
6
;
targetNode
.
HasChildren
:=
True
;
end
;
end
;
lEnumerator
.
MoveNext
;
end
;
finally
lEnumerator
.
Free
;
end
;
//Carrega os filhos
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
try
while
not
lEnumerator
.
EOL
do
while
not
lEnumerator
.
EOL
do
begin
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
Node
,
lFiltro
)
then
if
Assigned
(
lClassTicket
.
ParentClassTicket
)
then
begin
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
lFiltro
)
then
begin
lNodeParent
:=
Node
.
Owner
.
FindNodeWithData
(
lClassTicket
.
ParentClassTicket
);
if
Assigned
(
lNodeParent
)
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
lNodeParent
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
end
else
begin
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
end
;
targetNode
.
ImageIndex
:=
6
;
targetNode
.
ImageIndex
:=
6
;
targetNode
.
HasChildren
:=
True
;
targetNode
.
HasChildren
:=
True
;
end
;
end
;
end
;
lEnumerator
.
MoveNext
;
lEnumerator
.
MoveNext
;
end
;
end
;
finally
lEnumerator
.
Free
;
end
;
end
end
else
if
(
TObject
(
Node
.
Data
)
is
acClassTicket
)
then
else
if
(
TObject
(
Node
.
Data
)
is
acClassTicket
)
then
begin
begin
lClassTicket
:=
acClassTicket
(
Node
.
Data
);
lClassTicket
:=
acClassTicket
(
Node
.
Data
);
repeat
//
repeat
for
li
:=
0
to
pred
(
lClassTicket
.
Attributes
.
Count
)
do
for
li
:=
0
to
pred
(
lClassTicket
.
Attributes
.
Count
)
do
begin
begin
lAttributeTicket
:=
acAttributeTicket
(
lClassTicket
.
Attributes
.
Objects
[
li
]);
lAttributeTicket
:=
acAttributeTicket
(
lClassTicket
.
Attributes
.
Objects
[
li
]);
...
@@ -777,15 +814,14 @@ begin
...
@@ -777,15 +814,14 @@ begin
end
;
end
;
end
;
end
;
end
;
end
;
lClassTicket
:=
lClassTicket
.
ParentClassTicket
;
//
lClassTicket := lClassTicket.ParentClassTicket;
until
lClassTicket
=
nil
;
//
until lClassTicket = nil;
end
;
end
;
finally
finally
Node
.
Owner
.
EndUpdate
;
Node
.
Owner
.
EndUpdate
;
end
;
end
;
end
;
end
;
end
;
end
;
procedure
TExplorerV2
.
FormShow
(
Sender
:
TObject
);
procedure
TExplorerV2
.
FormShow
(
Sender
:
TObject
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment