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
c12f432b
Commit
c12f432b
authored
Sep 17, 2020
by
Jucelino Fonseca
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ajuste
parent
1c46e551
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
1806 additions
and
419 deletions
+1806
-419
CurioAddIn.lpi
EvoUMLPlugin/src/CurioAddIn.lpi
+2
-2
IntegracaoDelphiSUML.pas
EvoUMLPlugin/src/IntegracaoDelphiSUML.pas
+2
-1
fModelMappingsGenerationOptions.dfm
EvoUMLPlugin/src/fModelMappingsGenerationOptions.dfm
+139
-97
ituExplorerV2.dfm
EvoUMLPlugin/src/ituExplorerV2.dfm
+1381
-218
ituExplorerV2.pas
EvoUMLPlugin/src/ituExplorerV2.pas
+282
-101
No files found.
EvoUMLPlugin/src/CurioAddIn.lpi
View file @
c12f432b
<?xml version="1.0" encoding="UTF-8"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<CONFIG>
<ProjectOptions>
<ProjectOptions>
<Version
Value=
"1
2
"
/>
<Version
Value=
"1
1
"
/>
<PathDelim
Value=
"\"
/>
<PathDelim
Value=
"\"
/>
<General>
<General>
<Flags>
<Flags>
...
@@ -9,9 +9,9 @@
...
@@ -9,9 +9,9 @@
<MainUnitHasCreateFormStatements
Value=
"False"
/>
<MainUnitHasCreateFormStatements
Value=
"False"
/>
<MainUnitHasTitleStatement
Value=
"False"
/>
<MainUnitHasTitleStatement
Value=
"False"
/>
<MainUnitHasScaledStatement
Value=
"False"
/>
<MainUnitHasScaledStatement
Value=
"False"
/>
<CompatibilityMode
Value=
"True"
/>
</Flags>
</Flags>
<SessionStorage
Value=
"InProjectDir"
/>
<SessionStorage
Value=
"InProjectDir"
/>
<MainUnit
Value=
"0"
/>
<Title
Value=
"CurioAddIn"
/>
<Title
Value=
"CurioAddIn"
/>
<UseAppBundle
Value=
"False"
/>
<UseAppBundle
Value=
"False"
/>
<ResourceType
Value=
"res"
/>
<ResourceType
Value=
"res"
/>
...
...
EvoUMLPlugin/src/IntegracaoDelphiSUML.pas
View file @
c12f432b
...
@@ -1709,7 +1709,8 @@ begin
...
@@ -1709,7 +1709,8 @@ begin
end
;
end
;
end
;
end
;
function
TUtil
.
AlimentarMetamodelRegisterMapping
(
poClasseRaiz
:
IUMLClass
;
poMetaModel
:
acMetaModel
;
piMetaModelOptions
:
TMetaModelGenerationOptions
;
piProgress
:
TFShowProgress
):
string
;
function
TUtil
.
AlimentarMetamodelRegisterMapping
(
poClasseRaiz
:
IUMLClass
;
poMetaModel
:
acMetaModel
;
piMetaModelOptions
:
TMetaModelGenerationOptions
;
piProgress
:
TFShowProgress
):
string
;
var
index
,
index2
,
lFixSize
,
lVarSize
:
integer
;
var
index
,
index2
,
lFixSize
,
lVarSize
:
integer
;
lbMandatory
:
boolean
;
lbMandatory
:
boolean
;
lClassChild
:
IUMLClass
;
lClassChild
:
IUMLClass
;
...
...
EvoUMLPlugin/src/fModelMappingsGenerationOptions.dfm
View file @
c12f432b
object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
Left = 795
Left = 795
Height =
515
Height =
644
Top = 263
Top = 263
Width =
376
Width =
470
BorderStyle = bsDialog
BorderStyle = bsDialog
Caption = 'Model Mappings options'
Caption = 'Model Mappings options'
ClientHeight =
515
ClientHeight =
644
ClientWidth =
376
ClientWidth =
470
Color = clBtnFace
Color = clBtnFace
DesignTimePPI = 120
OnDestroy = FormDestroy
OnDestroy = FormDestroy
OnShow = FormShow
OnShow = FormShow
ParentFont = True
Position = poScreenCenter
Position = poScreenCenter
LCLVersion = '2.
1.
0.0'
LCLVersion = '2.
0.1
0.0'
object Panel1: TPanel
object Panel1: TPanel
Left = 0
Left = 0
Height =
56
Height =
70
Top =
459
Top =
574
Width =
376
Width =
470
Align = alBottom
Align = alBottom
ClientHeight = 56
ClientHeight = 70
ClientWidth = 376
ClientWidth = 470
ParentFont = False
TabOrder = 0
TabOrder = 0
object BitBtn1: TBitBtn
object BitBtn1: TBitBtn
Left =
16
0
Left =
20
0
Height =
34
Height =
42
Top = 1
4
Top = 1
8
Width = 1
00
Width = 1
25
Caption = 'Generate'
Caption = 'Generate'
Default = True
Default = True
Glyph.Data = {
Glyph.Data = {
...
@@ -74,62 +75,68 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
...
@@ -74,62 +75,68 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
FBFBFBFBFBFBFBFBDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDE
FBFBFBFBFBFBFBFBDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDE
}
}
OnClick = BitBtn1Click
OnClick = BitBtn1Click
ParentFont = False
TabOrder = 1
TabOrder = 1
end
end
object BitBtn2: TBitBtn
object BitBtn2: TBitBtn
Left =
268
Left =
335
Height =
34
Height =
42
Top = 1
4
Top = 1
8
Width = 1
00
Width = 1
25
Cancel = True
Cancel = True
DefaultCaption = True
DefaultCaption = True
Kind = bkCancel
Kind = bkCancel
ModalResult = 2
ModalResult = 2
NumGlyphs = 2
NumGlyphs = 2
ParentFont = False
TabOrder = 0
TabOrder = 0
end
end
object BitBtn3: TBitBtn
object BitBtn3: TBitBtn
Left =
7
Left =
9
Height =
25
Height =
31
Top = 2
3
Top = 2
9
Width =
89
Width =
111
Caption = 'Load Default'
Caption = 'Load Default'
OnClick = BitBtn3Click
OnClick = BitBtn3Click
ParentFont = False
TabOrder = 2
TabOrder = 2
end
end
object ckbDefault: TCheckBox
object ckbDefault: TCheckBox
Left =
7
Left =
9
Height =
19
Height =
24
Top =
3
Top =
4
Width =
58
Width =
73
Caption = 'Default'
Caption = 'Default'
Checked = True
Checked = True
ParentFont = False
State = cbChecked
State = cbChecked
TabOrder = 3
TabOrder = 3
end
end
end
end
object Panel2: TPanel
object Panel2: TPanel
Left = 0
Left = 0
Height =
459
Height =
574
Top = 0
Top = 0
Width =
376
Width =
470
Align = alClient
Align = alClient
ClientHeight = 459
ClientHeight = 574
ClientWidth = 376
ClientWidth = 470
ParentFont = False
TabOrder = 1
TabOrder = 1
object Label1: TLabel
object Label1: TLabel
Left =
8
Left =
10
Height =
15
Height =
20
Top =
8
Top =
10
Width =
91
Width =
112
Caption = 'Output directory:'
Caption = 'Output directory:'
ParentColor = False
ParentColor = False
ParentFont = False
end
end
object SpeedButton1: TSpeedButton
object SpeedButton1: TSpeedButton
Left =
345
Left =
431
Height = 2
2
Height = 2
8
Top = 2
Top = 2
Width = 2
3
Width = 2
9
Flat = True
Flat = True
Glyph.Data = {
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
36030000424D3603000000000000360000002800000010000000100000000100
...
@@ -160,102 +167,112 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
...
@@ -160,102 +167,112 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
85180C8518FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
85180C8518FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
}
}
OnClick = SpeedButton1Click
OnClick = SpeedButton1Click
ParentFont = False
end
end
object GroupBox1: TGroupBox
object GroupBox1: TGroupBox
Left =
8
Left =
10
Height =
8
0
Height =
10
0
Top =
24
0
Top =
30
0
Width =
36
0
Width =
45
0
Caption = 'Output file name'
Caption = 'Output file name'
ClientHeight = 60
ClientHeight = 75
ClientWidth = 356
ClientWidth = 446
ParentFont = False
TabOrder = 2
TabOrder = 2
object lblFileExists: TLabel
object lblFileExists: TLabel
Left =
8
Left =
10
Height = 1
4
Height = 1
6
Top =
34
Top =
42
Width =
194
Width =
251
Caption = 'File already exists at specified directory.'
Caption = 'File already exists at specified directory.'
Font.CharSet = ANSI_CHARSET
Font.CharSet = ANSI_CHARSET
Font.Color = clRed
Font.Color = clRed
Font.Height = -1
1
Font.Height = -1
4
Font.Name = 'Arial'
Font.Name = 'Arial'
ParentColor = False
ParentColor = False
ParentFont = False
ParentFont = False
end
end
object edtFileName: TEdit
object edtFileName: TEdit
Left =
6
Left =
8
Height = 2
3
Height = 2
8
Top =
8
Top =
10
Width =
338
Width =
422
OnChange = edtFileNameChange
OnChange = edtFileNameChange
ParentFont = False
TabOrder = 0
TabOrder = 0
end
end
end
end
object GroupBox2: TGroupBox
object GroupBox2: TGroupBox
Left =
8
Left =
10
Height =
56
Height =
70
Top =
326
Top =
408
Width =
36
0
Width =
45
0
Caption = 'Options'
Caption = 'Options'
ClientHeight = 36
ClientHeight = 45
ClientWidth = 356
ClientWidth = 446
ParentFont = False
TabOrder = 0
TabOrder = 0
object ckbIgnoreXSD: TCheckBox
object ckbIgnoreXSD: TCheckBox
Left =
8
Left =
10
Height =
19
Height =
24
Top =
8
Top =
10
Width = 1
22
Width = 1
53
Caption = 'Ignore XSD schema'
Caption = 'Ignore XSD schema'
ParentFont = False
TabOrder = 0
TabOrder = 0
end
end
end
end
object GroupBox3: TGroupBox
object GroupBox3: TGroupBox
Left =
8
Left =
10
Height =
56
Height =
70
Top =
393
Top =
491
Width =
36
0
Width =
45
0
Caption = 'Target Code Laguage'
Caption = 'Target Code Laguage'
ClientHeight = 36
ClientHeight = 45
ClientWidth = 356
ClientWidth = 446
ParentFont = False
TabOrder = 1
TabOrder = 1
object rdObjectPascal: TRadioButton
object rdObjectPascal: TRadioButton
Left =
8
Left =
10
Height =
19
Height =
24
Top =
8
Top =
10
Width =
91
Width =
113
Caption = 'Object Pascal'
Caption = 'Object Pascal'
OnClick = rdLanguageClick
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 0
TabOrder = 0
end
end
object rdCSharp: TRadioButton
object rdCSharp: TRadioButton
Left =
16
0
Left =
20
0
Height =
19
Height =
24
Top =
8
Top =
10
Width =
35
Width =
42
Caption = 'C#'
Caption = 'C#'
OnClick = rdLanguageClick
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 1
TabOrder = 1
end
end
object rdJava: TRadioButton
object rdJava: TRadioButton
Left =
272
Left =
340
Height =
19
Height =
24
Top =
8
Top =
10
Width =
4
2
Width =
5
2
Caption = 'Java'
Caption = 'Java'
OnClick = rdLanguageClick
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 2
TabOrder = 2
end
end
end
end
object dlbDirectory: TShellTreeView
object dlbDirectory: TShellTreeView
Left =
8
Left =
10
Height = 2
0
0
Height = 2
5
0
Top =
32
Top =
40
Width =
36
0
Width =
45
0
BorderWidth = 1
BorderWidth = 1
ExpandSignType = tvestPlusMinus
ExpandSignType = tvestPlusMinus
FileSortType = fstNone
FileSortType = fstNone
Images = ImageList1
Images = ImageList1
ParentFont = False
ReadOnly = True
ReadOnly = True
TabOrder = 3
TabOrder = 3
OnGetImageIndex = dlbDirectoryGetImageIndex
OnGetImageIndex = dlbDirectoryGetImageIndex
...
@@ -265,21 +282,46 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
...
@@ -265,21 +282,46 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
end
end
object OpenDialog1: TOpenDialog
object OpenDialog1: TOpenDialog
Filter = '.pas|*.pas'
Filter = '.pas|*.pas'
Left =
184
Left =
230
Top =
24
Top =
30
end
end
object ImageList1: TImageList
object ImageList1: TImageList
Left =
255
Left =
319
Top = 1
5
Top = 1
9
Bitmap = {
Bitmap = {
4C7A010000001000000010000000E20000000000000078DA63601878A0646061
4C69010000001000000010000000000000000000000000000000000000000000
C1641A12CA601A0AC12621A18AFA1616C4EA572F5FB18A69E1FFFF0C0BA078FE
0000000000000000000000000000000000000000000000000000000000000000
FFFFCE4B1F3C26DA8CEC55ABE07A0960B645FFFF979FFEFB1FA77EA03B9816E1
0000000000000000000000000000000000000000000000000000000000000000
C7BA1BB1EB6759F2FFBFF2B1FFFF354E11C69157FEFE37F7058619927EDE75C4
0000000000000000000000000000000000000000000000000000000000000000
E90561EBF3FFFE2BB8A3EA17DD4EBC7EDFCBFFFF1BF920F43302FD2DBD9778FD
0000000000000000000000000000000000002230383802355455003555550035
B1D781711480D0CFB2F4FF7FF983C4EB57EA58BE0A39FC385602C58E12AFDFA9
555500345455212F383800000000000000000000000000000000000000000000
7F055CBF79DD8A55D21BFFFD573BF6EFBFC609C2D8E2CCBFFF9EE9058530FD3A
0000000000000000000000000000000000002777A8AA02A1FFFF00A0FFFF00A0
C61616C27621A1BC0EC144615957A8BF070100002DAF7BBC
FFFF009FFFFF43A5E0E3212F3838000000000000000000000000000000000000
000000000000000000000000000000000000006BAAAA00A0FFFF00A0FFFF00A0
FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF00A0FFFF06A2
FFFF77CBFDFF000000000000000000000000006BAAAA00A0FFFF00A0FFFF00A1
FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2FFFF02A2
FFFF2DB1FDFF000000000000000000000000006BAAAA00A0FFFF04A4FFFF23C6
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF59D4FDFF374D545500000000006BAAAA00A0FFFF0DAEFFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF3BCFFEFF2047545500000000006BAAAA00A0FFFF15B7FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF4DD3FFFF324C545500000000006BAAAA01A1FFFF1BBDFFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF5DD7FFFF4350545500000000006BAAAA04A5FFFF1FC1FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF2288A7AA0000000000000000006BAAAA08A9FFFF22C5FFFF28CA
FFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CAFFFF28CA
FFFF28CAFFFF428FA8AA0000000000000000377EA8AA1BB1FEFF26C6FEFF28C8
FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8FEFF28C8
FEFF38CCFEFF4967707100000000000000002C333838133E54550D4053550D40
53550D4053550D4053550D4053550D4053550D4053550D4053550D4053550D40
53551D4554550000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
}
BitmapAdv = {
BitmapAdv = {
4C69010000004C7A010000001800000018000000E00000000000000078DA6360
4C69010000004C7A010000001800000018000000E00000000000000078DA6360
...
...
EvoUMLPlugin/src/ituExplorerV2.dfm
View file @
c12f432b
This source diff could not be displayed because it is too large. You can
view the blob
instead.
EvoUMLPlugin/src/ituExplorerV2.pas
View file @
c12f432b
...
@@ -5,7 +5,7 @@ interface
...
@@ -5,7 +5,7 @@ interface
uses
uses
LCLIntf
,
SysUtils
,
Variants
,
Classes
,
Graphics
,
Controls
,
Forms
,
LCLIntf
,
SysUtils
,
Variants
,
Classes
,
Graphics
,
Controls
,
Forms
,
Clipbrd
,
Dialogs
,
ExtCtrls
,
StdCtrls
,
ComCtrls
,
ActnList
,
Clipbrd
,
Dialogs
,
ExtCtrls
,
StdCtrls
,
ComCtrls
,
ActnList
,
LCLType
,
acuSQLDialectManager
,
ImgList
,
acuframework
,
LCLType
,
acuSQLDialectManager
,
ImgList
,
acuframework
,
utuMessage
,
IntegracaoDelphiSUML
,
acuObjectExplorer
,
Menus
,
Buttons
,
SynEdit
,
IntegracaoDelphiSUML
,
acuObjectExplorer
,
Menus
,
Buttons
,
SynEdit
,
SynHighlighterSQL
,
SynCompletion
,
acuModel
,
acuRepositorySQL
;
SynHighlighterSQL
,
SynCompletion
,
acuModel
,
acuRepositorySQL
;
...
@@ -26,11 +26,17 @@ type
...
@@ -26,11 +26,17 @@ type
TExplorerV2
=
class
(
TForm
)
TExplorerV2
=
class
(
TForm
)
actExecute
:
TAction
;
actExecute
:
TAction
;
actCancel
:
TAction
;
actCancel
:
TAction
;
edtClasse
:
TEdit
;
gbAgrupamento
:
TGroupBox
;
ilModel
:
TImageList
;
ilModel
:
TImageList
;
Label1
:
TLabel
;
lvXMLListResult
:
TListView
;
lvXMLListResult
:
TListView
;
memXMLTextResult
:
TMemo
;
memXMLTextResult
:
TMemo
;
OQLObjects
:
TObjectExplorer
;
OQLObjects
:
TObjectExplorer
;
pnFiltroClasse
:
TPanel
;
pcXMLResults
:
TPageControl
;
pcXMLResults
:
TPageControl
;
rbHieraquia
:
TRadioButton
;
rbSequencial
:
TRadioButton
;
ReconnectDB
:
TAction
;
ReconnectDB
:
TAction
;
sbStatusBar
:
TStatusBar
;
sbStatusBar
:
TStatusBar
;
spResultXML
:
TSplitter
;
spResultXML
:
TSplitter
;
...
@@ -75,9 +81,11 @@ type
...
@@ -75,9 +81,11 @@ type
memErrorText
:
TMemo
;
memErrorText
:
TMemo
;
pnlActionBar
:
TPanel
;
pnlActionBar
:
TPanel
;
procedure
actModelPanelExecute
(
Sender
:
TObject
);
procedure
actModelPanelExecute
(
Sender
:
TObject
);
procedure
edtClasseChange
(
Sender
:
TObject
);
procedure
FormClose
(
Sender
:
TObject
;
var
Action
:
TCloseAction
);
procedure
FormClose
(
Sender
:
TObject
;
var
Action
:
TCloseAction
);
procedure
FormShow
(
Sender
:
TObject
);
procedure
FormShow
(
Sender
:
TObject
);
procedure
actResultsPanelExecute
(
Sender
:
TObject
);
procedure
actResultsPanelExecute
(
Sender
:
TObject
);
procedure
rbSequencialClick
(
Sender
:
TObject
);
procedure
tvModelExplorerGetSelectedIndex
(
Sender
:
TObject
;
Node
:
TTreeNode
);
procedure
tvModelExplorerGetSelectedIndex
(
Sender
:
TObject
;
Node
:
TTreeNode
);
procedure
tvModelExplorerItemExpanding
(
Sender
:
TObject
;
Node
:
TTreeNode
;
var
AllowExpansion
:
Boolean
);
procedure
tvModelExplorerItemExpanding
(
Sender
:
TObject
;
Node
:
TTreeNode
;
var
AllowExpansion
:
Boolean
);
procedure
XMLQueryExecute
(
Sender
:
TObject
);
procedure
XMLQueryExecute
(
Sender
:
TObject
);
...
@@ -103,12 +111,14 @@ type
...
@@ -103,12 +111,14 @@ type
fSchema
:
String
;
fSchema
:
String
;
fUtil
:
TUtil
;
fUtil
:
TUtil
;
fLastExecErrorFlag
:
Boolean
;
fLastExecErrorFlag
:
Boolean
;
procedure
MontarModelExploreSequencial
(
Sender
:
TObject
;
Node
:
TTreeNode
);
procedure
MontarModelExploreHieraquia
(
Sender
:
TObject
;
Node
:
TTreeNode
);
procedure
SetMetaModel
(
const
Value
:
acMetaModel
);
procedure
SetMetaModel
(
const
Value
:
acMetaModel
);
procedure
ResizeColumns
(
piListView
:
TListView
);
procedure
ResizeColumns
(
piListView
:
TListView
);
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
;
piItemPai
:
TTreeNode
;
piFiltrar
:
boolean
):
boolean
;
protected
protected
procedure
CreateParams
(
var
Params
:
TCreateParams
);
override
;
procedure
CreateParams
(
var
Params
:
TCreateParams
);
override
;
function
Connect
:
acPersistenceSession
;
function
Connect
:
acPersistenceSession
;
...
@@ -127,10 +137,22 @@ var
...
@@ -127,10 +137,22 @@ var
implementation
implementation
uses
ituDataBaseLogin
,
DateUtils
,
acuObject
,
acuOQL
,
acuOQLtoSQLTranslator
,
uses
ituDataBaseLogin
,
DateUtils
,
acuObject
,
acuOQL
,
acuOQLtoSQLTranslator
,
utuMessage
,
ituOQLParams
;
ituOQLParams
;
{$R *.dfm}
{$R *.dfm}
function
TiraAcentos
(
const
s
:
string
):
string
;
const
Acentos
=
''
;
Letras
=
'AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioue'
;
var
i
:
Integer
;
begin
Result
:=
S
;
for
i
:=
1
to
Length
(
Acentos
)
do
while
Pos
(
acentos
[
i
],
Result
)>
0
do
Result
[
Pos
(
acentos
[
i
],
Result
)]:=
Letras
[
i
];
end
;
procedure
TExplorerV2
.
actExecuteExecute
(
Sender
:
TObject
);
procedure
TExplorerV2
.
actExecuteExecute
(
Sender
:
TObject
);
var
lSession
:
acPersistenceSession
;
var
lSession
:
acPersistenceSession
;
lList
:
acPersistentObjectList
;
lList
:
acPersistentObjectList
;
...
@@ -344,6 +366,12 @@ begin
...
@@ -344,6 +366,12 @@ begin
end
;
end
;
end
;
end
;
procedure
TExplorerV2
.
edtClasseChange
(
Sender
:
TObject
);
begin
tvModelExplorer
.
Items
.
Clear
;
MetaModel
:=
fUtil
.
MetaModel
;
end
;
procedure
TExplorerV2
.
actResultsPanelExecute
(
Sender
:
TObject
);
procedure
TExplorerV2
.
actResultsPanelExecute
(
Sender
:
TObject
);
var
var
lAction
:
TAction
;
lAction
:
TAction
;
...
@@ -391,6 +419,13 @@ begin
...
@@ -391,6 +419,13 @@ begin
end
;
end
;
end
;
end
;
procedure
TExplorerV2
.
rbSequencialClick
(
Sender
:
TObject
);
begin
end
;
procedure
TExplorerV2
.
tvModelExplorerGetSelectedIndex
(
Sender
:
TObject
;
Node
:
TTreeNode
);
procedure
TExplorerV2
.
tvModelExplorerGetSelectedIndex
(
Sender
:
TObject
;
Node
:
TTreeNode
);
begin
begin
Node
.
SelectedIndex
:=
Node
.
ImageIndex
;
Node
.
SelectedIndex
:=
Node
.
ImageIndex
;
...
@@ -485,6 +520,24 @@ begin
...
@@ -485,6 +520,24 @@ begin
Clipbrd
.
Clipboard
.
AsText
:=
lString
;
Clipbrd
.
Clipboard
.
AsText
:=
lString
;
end
;
end
;
function
TExplorerV2
.
BuscaParcialClasse
(
piCLasse
:
string
;
piItemPai
:
TTreeNode
;
piFiltrar
:
boolean
):
boolean
;
var
lClasseTree
,
lClasseP
:
string
;
begin
if
piFiltrar
then
begin
lClasseP
:=
TiraAcentos
(
trim
(
UpperCase
(
edtClasse
.
Text
)));
lClasseTree
:=
TiraAcentos
(
trim
(
UpperCase
(
piCLasse
)));
result
:=
Pos
(
lClasseP
,
lClasseTree
)
>
0
;
end
else
begin
result
:=
true
;
end
;
end
;
procedure
TExplorerV2
.
CreateParams
(
var
Params
:
TCreateParams
);
procedure
TExplorerV2
.
CreateParams
(
var
Params
:
TCreateParams
);
begin
begin
inherited
CreateParams
(
Params
);
inherited
CreateParams
(
Params
);
...
@@ -516,6 +569,225 @@ begin
...
@@ -516,6 +569,225 @@ begin
fUtil
.
Free
;
fUtil
.
Free
;
end
;
end
;
procedure
TExplorerV2
.
MontarModelExploreSequencial
(
Sender
:
TObject
;
Node
:
TTreeNode
);
var
lClassTicket
:
acClassTicket
;
lAttributeTicket
:
acAttributeTicket
;
lRelationTicket
:
acRelationTicket
;
lCardinality
:
string
;
lEnumerator
:
acEnumerator
;
li
:
integer
;
targetNode
:
TTreeNode
;
lFiltro
:
boolean
;
begin
lFiltro
:=
trim
(
edtClasse
.
Text
)
<>
''
;
if
Node
.
HasChildren
and
(
Node
.
Count
=
0
)
then
begin
Node
.
Owner
.
BeginUpdate
;
try
if
(
TObject
(
Node
.
Data
)
is
acMetaModel
)
then
begin
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
while
not
lEnumerator
.
EOL
do
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
Node
,
lFiltro
)
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
.
ImageIndex
:=
6
;
targetNode
.
HasChildren
:=
True
;
end
;
lEnumerator
.
MoveNext
;
end
;
end
else
if
(
TObject
(
Node
.
Data
)
is
acClassTicket
)
then
begin
lClassTicket
:=
acClassTicket
(
Node
.
Data
);
repeat
for
li
:=
0
to
pred
(
lClassTicket
.
Attributes
.
Count
)
do
begin
lAttributeTicket
:=
acAttributeTicket
(
lClassTicket
.
Attributes
.
Objects
[
li
]);
if
lAttributeTicket
.
Stereotype
=
acAttributeStereotype
.
pvPersistent
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lAttributeTicket
.
AttributeName
+
': '
+
lAttributeTicket
.
AttributeType
,
lAttributeTicket
);
if
lAttributeTicket
.
Mandatory
then
targetNode
.
ImageIndex
:=
5
else
targetNode
.
ImageIndex
:=
0
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsIn
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsIn
.
Objects
[
li
]);
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
DestinationMaxMultiplicity
);
if
lRelationTicket
.
DestinationPropertyName
<>
''
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
DestinationPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
OriginClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
OriginClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
else
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsOut
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsOut
.
Objects
[
li
]);
if
lRelationTicket
.
OriginPropertyName
<>
''
then
begin
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
OriginMaxMultiplicity
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
OriginPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
DestinationClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
DestinationClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
else
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
lClassTicket
:=
lClassTicket
.
ParentClassTicket
;
until
lClassTicket
=
nil
;
end
;
finally
Node
.
Owner
.
EndUpdate
;
end
;
end
;
end
;
procedure
TExplorerV2
.
MontarModelExploreHieraquia
(
Sender
:
TObject
;
Node
:
TTreeNode
);
var
lClassTicket
:
acClassTicket
;
lAttributeTicket
:
acAttributeTicket
;
lRelationTicket
:
acRelationTicket
;
lCardinality
:
string
;
lEnumerator
:
acEnumerator
;
li
:
integer
;
targetNode
:
TTreeNode
;
lFiltro
:
boolean
;
begin
lFiltro
:=
trim
(
edtClasse
.
Text
)
<>
''
;
if
Node
.
HasChildren
and
(
Node
.
Count
=
0
)
then
begin
Node
.
Owner
.
BeginUpdate
;
try
if
(
TObject
(
Node
.
Data
)
is
acMetaModel
)
then
begin
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
while
not
lEnumerator
.
EOL
do
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
if
BuscaParcialClasse
(
lClassTicket
.
PersistentObjectClassName
,
Node
,
lFiltro
)
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
.
ImageIndex
:=
6
;
targetNode
.
HasChildren
:=
True
;
end
;
lEnumerator
.
MoveNext
;
end
;
end
else
if
(
TObject
(
Node
.
Data
)
is
acClassTicket
)
then
begin
lClassTicket
:=
acClassTicket
(
Node
.
Data
);
repeat
for
li
:=
0
to
pred
(
lClassTicket
.
Attributes
.
Count
)
do
begin
lAttributeTicket
:=
acAttributeTicket
(
lClassTicket
.
Attributes
.
Objects
[
li
]);
if
lAttributeTicket
.
Stereotype
=
acAttributeStereotype
.
pvPersistent
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lAttributeTicket
.
AttributeName
+
': '
+
lAttributeTicket
.
AttributeType
,
lAttributeTicket
);
if
lAttributeTicket
.
Mandatory
then
targetNode
.
ImageIndex
:=
5
else
targetNode
.
ImageIndex
:=
0
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsIn
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsIn
.
Objects
[
li
]);
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
DestinationMaxMultiplicity
);
if
lRelationTicket
.
DestinationPropertyName
<>
''
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
DestinationPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
OriginClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
OriginClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
else
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsOut
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsOut
.
Objects
[
li
]);
if
lRelationTicket
.
OriginPropertyName
<>
''
then
begin
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
OriginMaxMultiplicity
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
OriginPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
DestinationClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
DestinationClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
else
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
lClassTicket
:=
lClassTicket
.
ParentClassTicket
;
until
lClassTicket
=
nil
;
end
;
finally
Node
.
Owner
.
EndUpdate
;
end
;
end
;
end
;
procedure
TExplorerV2
.
FormShow
(
Sender
:
TObject
);
procedure
TExplorerV2
.
FormShow
(
Sender
:
TObject
);
begin
begin
OQLQuery
.
Execute
;
OQLQuery
.
Execute
;
...
@@ -780,105 +1052,14 @@ begin
...
@@ -780,105 +1052,14 @@ begin
end
;
end
;
procedure
TExplorerV2
.
tvModelExplorerItemExpanding
(
Sender
:
TObject
;
Node
:
TTreeNode
;
var
AllowExpansion
:
Boolean
);
procedure
TExplorerV2
.
tvModelExplorerItemExpanding
(
Sender
:
TObject
;
Node
:
TTreeNode
;
var
AllowExpansion
:
Boolean
);
var
lClassTicket
:
acClassTicket
;
lAttributeTicket
:
acAttributeTicket
;
lRelationTicket
:
acRelationTicket
;
lCardinality
:
string
;
lEnumerator
:
acEnumerator
;
li
:
integer
;
targetNode
:
TTreeNode
;
begin
begin
if
Node
.
HasChildren
and
(
Node
.
Count
=
0
)
then
if
rbSequencial
.
Checked
then
begin
Node
.
Owner
.
BeginUpdate
;
try
if
(
TObject
(
Node
.
Data
)
is
acMetaModel
)
then
begin
lEnumerator
:=
acMetaModel
(
Node
.
Data
).
ClassTickets
.
GetEnumerator
;
while
not
lEnumerator
.
EOL
do
begin
lClassTicket
:=
acClassTicket
(
lEnumerator
.
Current
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lClassTicket
.
PersistentObjectClassName
,
lClassTicket
);
targetNode
.
ImageIndex
:=
6
;
targetNode
.
HasChildren
:=
True
;
lEnumerator
.
MoveNext
;
end
;
end
else
if
(
TObject
(
Node
.
Data
)
is
acClassTicket
)
then
begin
lClassTicket
:=
acClassTicket
(
Node
.
Data
);
repeat
for
li
:=
0
to
pred
(
lClassTicket
.
Attributes
.
Count
)
do
begin
lAttributeTicket
:=
acAttributeTicket
(
lClassTicket
.
Attributes
.
Objects
[
li
]);
if
lAttributeTicket
.
Stereotype
=
acAttributeStereotype
.
pvPersistent
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lAttributeTicket
.
AttributeName
+
': '
+
lAttributeTicket
.
AttributeType
,
lAttributeTicket
);
if
lAttributeTicket
.
Mandatory
then
targetNode
.
ImageIndex
:=
5
else
targetNode
.
ImageIndex
:=
0
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsIn
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsIn
.
Objects
[
li
]);
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
DestinationMaxMultiplicity
);
if
lRelationTicket
.
DestinationPropertyName
<>
''
then
begin
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
DestinationPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
OriginClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
OriginClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
DestinationMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
else
begin
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
MontarModelExploreSequencial
(
Sender
,
Node
);
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
for
li
:=
0
to
pred
(
lClassTicket
.
RelationTicketsOut
.
Count
)
do
begin
lRelationTicket
:=
acRelationTicket
(
lClassTicket
.
RelationTicketsOut
.
Objects
[
li
]);
if
lRelationTicket
.
OriginPropertyName
<>
''
then
begin
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
lCardinality
:=
'*'
else
lCardinality
:=
inttostr
(
lRelationTicket
.
OriginMaxMultiplicity
);
targetNode
:=
Node
.
Owner
.
AddChildObject
(
Node
,
lRelationTicket
.
OriginPropertyName
+
': ('
+
lCardinality
+
') '
+
lRelationTicket
.
DestinationClassTicket
.
PersistentObjectClassName
,
lRelationTicket
.
DestinationClassTicket
);
targetNode
.
HasChildren
:=
True
;
if
lRelationTicket
.
OriginMaxMultiplicity
=
N
then
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
targetNode
.
ImageIndex
:=
4
else
targetNode
.
ImageIndex
:=
2
;
end
end
else
else
if
rbHieraquia
.
Checked
then
begin
begin
if
lRelationTicket
.
DestinationMinMultiplicity
=
1
then
MontarModelExploreHieraquia
(
Sender
,
Node
);
targetNode
.
ImageIndex
:=
3
else
targetNode
.
ImageIndex
:=
1
;
end
;
end
;
end
;
lClassTicket
:=
lClassTicket
.
ParentClassTicket
;
until
lClassTicket
=
nil
;
end
;
finally
Node
.
Owner
.
EndUpdate
;
end
;
end
;
end
;
end
;
end
;
...
...
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