Skip to content

S
StarUML Evológica Plugin
Commit c12f432b authored by Jucelino Fonseca's avatar Jucelino Fonseca
Browse files
Options

ajuste

parent 1c46e551
Show whitespace changes
Inline Side-by-side
Showing with 1806 additions and 419 deletions
EvoUMLPlugin/src/CurioAddIn.lpi
View file @ c12f432b
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
......@@ -9,9 +9,9 @@
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="CurioAddIn"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
......
EvoUMLPlugin/src/IntegracaoDelphiSUML.pas
View file @ c12f432b
......@@ -1709,7 +1709,8 @@ begin
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;
lbMandatory: boolean;
lClassChild: IUMLClass;
......
EvoUMLPlugin/src/fModelMappingsGenerationOptions.dfm
View file @ c12f432b
object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
Left = 795
Height = 515
Height = 644
Top = 263
Width = 376
Width = 470
BorderStyle = bsDialog
Caption = 'Model Mappings options'
ClientHeight = 515
ClientWidth = 376
ClientHeight = 644
ClientWidth = 470
Color = clBtnFace
DesignTimePPI = 120
OnDestroy = FormDestroy
OnShow = FormShow
ParentFont = True
Position = poScreenCenter
LCLVersion = '2.1.0.0'
LCLVersion = '2.0.10.0'
object Panel1: TPanel
Left = 0
Height = 56
Top = 459
Width = 376
Height = 70
Top = 574
Width = 470
Align = alBottom
ClientHeight = 56
ClientWidth = 376
ClientHeight = 70
ClientWidth = 470
ParentFont = False
TabOrder = 0
object BitBtn1: TBitBtn
Left = 160
Height = 34
Top = 14
Width = 100
Left = 200
Height = 42
Top = 18
Width = 125
Caption = 'Generate'
Default = True
Glyph.Data = {
......@@ -74,62 +75,68 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
FBFBFBFBFBFBFBFBDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDE
}
OnClick = BitBtn1Click
ParentFont = False
TabOrder = 1
end
object BitBtn2: TBitBtn
Left = 268
Height = 34
Top = 14
Width = 100
Left = 335
Height = 42
Top = 18
Width = 125
Cancel = True
DefaultCaption = True
Kind = bkCancel
ModalResult = 2
NumGlyphs = 2
ParentFont = False
TabOrder = 0
end
object BitBtn3: TBitBtn
Left = 7
Height = 25
Top = 23
Width = 89
Left = 9
Height = 31
Top = 29
Width = 111
Caption = 'Load Default'
OnClick = BitBtn3Click
ParentFont = False
TabOrder = 2
end
object ckbDefault: TCheckBox
Left = 7
Height = 19
Top = 3
Width = 58
Left = 9
Height = 24
Top = 4
Width = 73
Caption = 'Default'
Checked = True
ParentFont = False
State = cbChecked
TabOrder = 3
end
end
object Panel2: TPanel
Left = 0
Height = 459
Height = 574
Top = 0
Width = 376
Width = 470
Align = alClient
ClientHeight = 459
ClientWidth = 376
ClientHeight = 574
ClientWidth = 470
ParentFont = False
TabOrder = 1
object Label1: TLabel
Left = 8
Height = 15
Top = 8
Width = 91
Left = 10
Height = 20
Top = 10
Width = 112
Caption = 'Output directory:'
ParentColor = False
ParentFont = False
end
object SpeedButton1: TSpeedButton
Left = 345
Height = 22
Left = 431
Height = 28
Top = 2
Width = 23
Width = 29
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
......@@ -160,102 +167,112 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
85180C8518FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
}
OnClick = SpeedButton1Click
ParentFont = False
end
object GroupBox1: TGroupBox
Left = 8
Height = 80
Top = 240
Width = 360
Left = 10
Height = 100
Top = 300
Width = 450
Caption = 'Output file name'
ClientHeight = 60
ClientWidth = 356
ClientHeight = 75
ClientWidth = 446
ParentFont = False
TabOrder = 2
object lblFileExists: TLabel
Left = 8
Height = 14
Top = 34
Width = 194
Left = 10
Height = 16
Top = 42
Width = 251
Caption = 'File already exists at specified directory.'
Font.CharSet = ANSI_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Height = -14
Font.Name = 'Arial'
ParentColor = False
ParentFont = False
end
object edtFileName: TEdit
Left = 6
Height = 23
Top = 8
Width = 338
Left = 8
Height = 28
Top = 10
Width = 422
OnChange = edtFileNameChange
ParentFont = False
TabOrder = 0
end
end
object GroupBox2: TGroupBox
Left = 8
Height = 56
Top = 326
Width = 360
Left = 10
Height = 70
Top = 408
Width = 450
Caption = 'Options'
ClientHeight = 36
ClientWidth = 356
ClientHeight = 45
ClientWidth = 446
ParentFont = False
TabOrder = 0
object ckbIgnoreXSD: TCheckBox
Left = 8
Height = 19
Top = 8
Width = 122
Left = 10
Height = 24
Top = 10
Width = 153
Caption = 'Ignore XSD schema'
ParentFont = False
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 8
Height = 56
Top = 393
Width = 360
Left = 10
Height = 70
Top = 491
Width = 450
Caption = 'Target Code Laguage'
ClientHeight = 36
ClientWidth = 356
ClientHeight = 45
ClientWidth = 446
ParentFont = False
TabOrder = 1
object rdObjectPascal: TRadioButton
Left = 8
Height = 19
Top = 8
Width = 91
Left = 10
Height = 24
Top = 10
Width = 113
Caption = 'Object Pascal'
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 0
end
object rdCSharp: TRadioButton
Left = 160
Height = 19
Top = 8
Width = 35
Left = 200
Height = 24
Top = 10
Width = 42
Caption = 'C#'
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 1
end
object rdJava: TRadioButton
Left = 272
Height = 19
Top = 8
Width = 42
Left = 340
Height = 24
Top = 10
Width = 52
Caption = 'Java'
OnClick = rdLanguageClick
ParentFont = False
TabOrder = 2
end
end
object dlbDirectory: TShellTreeView
Left = 8
Height = 200
Top = 32
Width = 360
Left = 10
Height = 250
Top = 40
Width = 450
BorderWidth = 1
ExpandSignType = tvestPlusMinus
FileSortType = fstNone
Images = ImageList1
ParentFont = False
ReadOnly = True
TabOrder = 3
OnGetImageIndex = dlbDirectoryGetImageIndex
......@@ -265,21 +282,46 @@ object ModelMappingsGenerationOptions: TModelMappingsGenerationOptions
end
object OpenDialog1: TOpenDialog
Filter = '.pas|*.pas'
Left = 184
Top = 24
Left = 230
Top = 30
end
object ImageList1: TImageList
Left = 255
Top = 15
Left = 319
Top = 19
Bitmap = {
4C7A010000001000000010000000E20000000000000078DA63601878A0646061
C1641A12CA601A0AC12621A18AFA1616C4EA572F5FB18A69E1FFFF0C0BA078FE
FFFFCE4B1F3C26DA8CEC55ABE07A0960B645FFFF979FFEFB1FA77EA03B9816E1
C7BA1BB1EB6759F2FFBFF2B1FFFF354E11C69157FEFE37F7058619927EDE75C4
E90561EBF3FFFE2BB8A3EA17DD4EBC7EDFCBFFFF1BF920F43302FD2DBD9778FD
B1D781711480D0CFB2F4FF7FF983C4EB57EA58BE0A39FC385602C58E12AFDFA9
7F055CBF79DD8A55D21BFFFD573BF6EFBFC609C2D8E2CCBFFF9EE9058530FD3A
C61616C27621A1BC0EC144615957A8BF070100002DAF7BBC
4C69010000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000002230383802355455003555550035
555500345455212F383800000000000000000000000000000000000000000000
0000000000000000000000000000000000002777A8AA02A1FFFF00A0FFFF00A0
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 = {
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
uses
LCLIntf, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Clipbrd, Dialogs, ExtCtrls, StdCtrls, ComCtrls, ActnList,
LCLType, acuSQLDialectManager, ImgList, acuframework,
LCLType, acuSQLDialectManager, ImgList, acuframework, utuMessage,
IntegracaoDelphiSUML, acuObjectExplorer, Menus, Buttons, SynEdit,
SynHighlighterSQL, SynCompletion, acuModel, acuRepositorySQL;
......@@ -26,11 +26,17 @@ type
TExplorerV2 = class(TForm)
actExecute: TAction;
actCancel: TAction;
edtClasse: TEdit;
gbAgrupamento: TGroupBox;
ilModel: TImageList;
Label1: TLabel;
lvXMLListResult: TListView;
memXMLTextResult: TMemo;
OQLObjects: TObjectExplorer;
pnFiltroClasse: TPanel;
pcXMLResults: TPageControl;
rbHieraquia: TRadioButton;
rbSequencial: TRadioButton;
ReconnectDB: TAction;
sbStatusBar: TStatusBar;
spResultXML: TSplitter;
......@@ -75,9 +81,11 @@ type
memErrorText: TMemo;
pnlActionBar: TPanel;
procedure actModelPanelExecute(Sender: TObject);
procedure edtClasseChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure actResultsPanelExecute(Sender: TObject);
procedure rbSequencialClick(Sender: TObject);
procedure tvModelExplorerGetSelectedIndex(Sender: TObject; Node: TTreeNode);
procedure tvModelExplorerItemExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
procedure XMLQueryExecute(Sender: TObject);
......@@ -103,12 +111,14 @@ type
fSchema: String;
fUtil: TUtil;
fLastExecErrorFlag: Boolean;
procedure MontarModelExploreSequencial(Sender: TObject; Node: TTreeNode);
procedure MontarModelExploreHieraquia(Sender: TObject; Node: TTreeNode);
procedure SetMetaModel(const Value: acMetaModel);
procedure ResizeColumns(piListView: TListView);
function GetStringEntreParenteses(piString : string) : string;
function GetNumeroDeStringOID (piString : string) : string;
procedure CopiaTextoObjeto (piObjeto : TTreeNode);
function BuscaParcialClasse(piCLasse: string; piItemPai: TTreeNode; piFiltrar: boolean): boolean;
protected
procedure CreateParams(var Params : TCreateParams); override;
function Connect : acPersistenceSession;
......@@ -127,10 +137,22 @@ var
implementation
uses ituDataBaseLogin, DateUtils, acuObject, acuOQL, acuOQLtoSQLTranslator,
utuMessage, ituOQLParams;
ituOQLParams;
{$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);
var lSession: acPersistenceSession;
lList: acPersistentObjectList;
......@@ -344,6 +366,12 @@ begin
end;
end;
procedure TExplorerV2.edtClasseChange(Sender: TObject);
begin
tvModelExplorer.Items.Clear;
MetaModel := fUtil.MetaModel;
end;
procedure TExplorerV2.actResultsPanelExecute(Sender: TObject);
var
lAction : TAction;
......@@ -391,6 +419,13 @@ begin
end;
end;
procedure TExplorerV2.rbSequencialClick(Sender: TObject);
begin
end;
procedure TExplorerV2.tvModelExplorerGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
Node.SelectedIndex := Node.ImageIndex;
......@@ -485,6 +520,24 @@ begin
Clipbrd.Clipboard.AsText := lString;
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);
begin
inherited CreateParams(Params);
......@@ -516,6 +569,225 @@ begin
fUtil.Free;
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);
begin
OQLQuery.Execute;
......@@ -780,105 +1052,14 @@ begin
end;
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
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);
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
if rbSequencial.Checked then
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;
MontarModelExploreSequencial(Sender,Node);
end
else
else if rbHieraquia.Checked then
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;
MontarModelExploreHieraquia(Sender,Node);
end;
end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment