Commit c12f432b authored by Jucelino Fonseca's avatar Jucelino Fonseca

ajuste

parent 1c46e551
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="12"/> <Version Value="11"/>
<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"/>
......
...@@ -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;
......
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.10.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 = 160 Left = 200
Height = 34 Height = 42
Top = 14 Top = 18
Width = 100 Width = 125
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 = 14 Top = 18
Width = 100 Width = 125
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 = 23 Top = 29
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 = 22 Height = 28
Top = 2 Top = 2
Width = 23 Width = 29
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 = 80 Height = 100
Top = 240 Top = 300
Width = 360 Width = 450
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 = 14 Height = 16
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 = -11 Font.Height = -14
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 = 23 Height = 28
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 = 360 Width = 450
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 = 122 Width = 153
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 = 360 Width = 450
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 = 160 Left = 200
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 = 42 Width = 52
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 = 200 Height = 250
Top = 32 Top = 40
Width = 360 Width = 450
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 = 15 Top = 19
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
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -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;
......
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