Skip to content

Commit aceebcc

Browse files
TiagoadvirTiagoadvir
committed
Adicionado modo de acesso, 'Orientado a interface'. Esse modo cria a interface, e sua implementação na classse
1 parent c622ef5 commit aceebcc

File tree

4 files changed

+215
-28
lines changed

4 files changed

+215
-28
lines changed

‎Src/Types/Types.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ interface
44

55
type
66
{$SCOPEDENUMS ON}
7-
TFormaAcesso = (PropertyDireto, PropertyGetSet, GetSet, FluentInterface);
7+
TFormaAcesso = (PropertyDireto, PropertyGetSet, GetSet, FluentInterface, OrientadoInterface);
88
TORM = (None, SimpleORM);
99
{$SCOPEDENUMS OFF}
1010

‎Src/View/View.Main.dfm‎

Lines changed: 16 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -258,7 +258,7 @@ object ViewMain: TViewMain
258258
Top = 0
259259
Width = 1035
260260
Height = 620
261-
ActivePage = tabConexao
261+
ActivePage = tabGerador
262262
Align = alClient
263263
TabOrder = 1
264264
ExplicitWidth = 1031
@@ -273,8 +273,6 @@ object ViewMain: TViewMain
273273
Align = alClient
274274
BevelOuter = bvNone
275275
TabOrder = 0
276-
ExplicitWidth = 1023
277-
ExplicitHeight = 591
278276
object Label2: TLabel
279277
Left = 24
280278
Top = 5
@@ -504,6 +502,8 @@ object ViewMain: TViewMain
504502
BevelOuter = bvNone
505503
ParentBackground = False
506504
TabOrder = 0
505+
ExplicitWidth = 1023
506+
ExplicitHeight = 591
507507
object Splitter1: TSplitter
508508
Left = 297
509509
Top = 0
@@ -521,6 +521,7 @@ object ViewMain: TViewMain
521521
BevelOuter = bvNone
522522
ParentBackground = False
523523
TabOrder = 0
524+
ExplicitHeight = 591
524525
object Panel6: TPanel
525526
AlignWithMargins = True
526527
Left = 0
@@ -679,6 +680,8 @@ object ViewMain: TViewMain
679680
BevelOuter = bvNone
680681
ParentBackground = False
681682
TabOrder = 1
683+
ExplicitWidth = 723
684+
ExplicitHeight = 591
682685
object mmLog: TMemo
683686
Left = 0
684687
Top = 297
@@ -693,6 +696,8 @@ object ViewMain: TViewMain
693696
ParentFont = False
694697
ScrollBars = ssVertical
695698
TabOrder = 0
699+
ExplicitWidth = 723
700+
ExplicitHeight = 261
696701
end
697702
object Panel7: TPanel
698703
Left = 0
@@ -707,13 +712,15 @@ object ViewMain: TViewMain
707712
BevelOuter = bvNone
708713
ParentBackground = False
709714
TabOrder = 1
715+
ExplicitWidth = 723
710716
object Panel1: TPanel
711717
Left = 0
712718
Top = 0
713719
Width = 727
714720
Height = 59
715721
Align = alTop
716722
TabOrder = 0
723+
ExplicitWidth = 723
717724
object Label8: TLabel
718725
Left = 7
719726
Top = 0
@@ -748,14 +755,14 @@ object ViewMain: TViewMain
748755
object ckGravarArquivosPasta: TCheckBox
749756
Left = 7
750757
Top = 38
751-
Width = 139
758+
Width = 149
752759
Height = 17
753760
Cursor = crHandPoint
754761
Caption = 'Gravar arquivos na pasta'
755762
TabOrder = 2
756763
end
757764
object ckAbrirPastaAposGravar: TCheckBox
758-
Left = 154
765+
Left = 162
759766
Top = 38
760767
Width = 147
761768
Height = 17
@@ -810,7 +817,8 @@ object ViewMain: TViewMain
810817
'Property acesso direto'
811818
'Property acesso Get e Set'
812819
'Func'#245'es com prefixo Get e Set'
813-
'Fun'#231#245'es fluent interface (overload)')
820+
'Fun'#231#245'es fluent interface (overload)'
821+
'Orientado a Interfaces')
814822
TabOrder = 1
815823
end
816824
end
@@ -1052,6 +1060,8 @@ object ViewMain: TViewMain
10521060
Padding.Bottom = 3
10531061
ParentBackground = False
10541062
TabOrder = 2
1063+
ExplicitTop = 558
1064+
ExplicitWidth = 723
10551065
object btnLogLimpar: TButton
10561066
Left = 3
10571067
Top = 3

‎Src/View/View.Main.pas‎

Lines changed: 188 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,7 @@ TViewMain = class(TForm)
139139
FClasseNome: string;
140140
FUnitNome: string;
141141
FTabelaLB: string;
142+
FInterfaceGerada : Boolean;
142143
FFormaAcesso: TFormaAcesso;
143144
FORM: TORM;
144145
procedure ConfSGBD;
@@ -161,6 +162,14 @@ TViewMain = class(TForm)
161162
procedure ConfFormSimpleORM;
162163
procedure ProcessaGetSetImplementacao(AFieldNameLB, AFieldTipo: string);
163164
procedure FiltraTabela;
165+
procedure GerarInterface(AtableName: string);
166+
procedure GeraTopoInterface;
167+
procedure ProcessarContratoInterface(AFieldNameLB: string; AFieldTipo: string);
168+
procedure GerarImplementacaodaClasseInterface(AtableName: string);
169+
procedure GeraTopoClasseInterface;
170+
procedure ProcessaOrientacaoInterface(AFieldNameLB, AFieldTipo: string);
171+
procedure GeraDestructor;
172+
procedure InstanciaFactoryMethod;
164173
public
165174

166175
end;
@@ -630,7 +639,12 @@ procedure TViewMain.btnGerarClassEntitiesSelecionadosClick(Sender: TObject);
630639
while(not dm.FDMemTableTabelas.Eof)do
631640
begin
632641
if(dm.FDMemTableTabelasmarcado.AsString = 'S')then
633-
Self.GerarClassesTabela(dm.FDMemTableTabelasnome_tabela.AsString);
642+
begin
643+
if rdGroupFormaAcessoEntities.ItemIndex = 4 then
644+
Self.GerarInterface(dm.FDMemTableTabelasnome_tabela.AsString)
645+
else
646+
Self.GerarClassesTabela(dm.FDMemTableTabelasnome_tabela.AsString);
647+
end;
634648
dm.FDMemTableTabelas.Next;
635649
end;
636650
finally
@@ -643,6 +657,89 @@ procedure TViewMain.btnGerarClassEntitiesSelecionadosClick(Sender: TObject);
643657
ShellExecute(Application.Handle, 'open', PChar(ExtractFilePath(FDirSalvar)), nil, nil, SW_SHOWNORMAL);
644658
end;
645659

660+
procedure TViewMain.GerarInterface(AtableName: string);
661+
begin
662+
FTabelaName := AtableName;
663+
FStrGeral.Clear;
664+
if(ckLimparMemoACadaUnit.Checked)then
665+
mmLog.Lines.Clear;
666+
dm.FDMetaInfoQueryFIelds.Close;
667+
dm.FDMetaInfoQueryFIelds.ObjectName := AtableName;
668+
dm.FDMetaInfoQueryFIelds.Open;
669+
670+
FTabelaLB := AtableName;
671+
if(ckUpperCamelCaseInTables.Checked)then
672+
FTabelaLB := TUtils.FormataNome(FTabelaLB);
673+
674+
FUnitNome := StringReplace(edtNomeEntities.Text, '<NomeTabela>', FTabelaLB, [rfReplaceAll, rfIgnoreCase]);
675+
FClasseNome := TUtils.RemovePontos(FUnitNome);
676+
677+
Self.GeraTopoInterface;
678+
Self.LacoEmFields;
679+
FInterfaceGerada := True;
680+
Self.GeraPublic;
681+
FStrGeral.Add('implementation');
682+
FStrGeral.Add('end.');
683+
mmLog.Lines.Add(FStrGeral.Text.TrimRight);
684+
685+
if(ckGravarArquivosPasta.Checked)then
686+
FStrGeral.SaveToFile(FDirSalvar + 'i' + FUnitNome + '_.pas');
687+
688+
Self.GerarImplementacaodaClasseInterface(AtableName);
689+
690+
end;
691+
692+
procedure TViewMain.GerarImplementacaodaClasseInterface(AtableName: string);
693+
begin
694+
FTabelaName := AtableName;
695+
FStrGeral.Clear;
696+
if(ckLimparMemoACadaUnit.Checked) and not (rdGroupFormaAcessoEntities.ItemIndex = 4 ) then
697+
mmLog.Lines.Clear;
698+
dm.FDMetaInfoQueryFIelds.Close;
699+
dm.FDMetaInfoQueryFIelds.ObjectName := AtableName;
700+
dm.FDMetaInfoQueryFIelds.Open;
701+
702+
FTabelaLB := AtableName;
703+
if(ckUpperCamelCaseInTables.Checked)then
704+
FTabelaLB := TUtils.FormataNome(FTabelaLB);
705+
FUnitNome := StringReplace(edtNomeEntities.Text, '<NomeTabela>', FTabelaLB, [rfReplaceAll, rfIgnoreCase]);
706+
FClasseNome := 'T' + TUtils.RemovePontos(FUnitNome);
707+
708+
Self.GeraTopoClasseInterface;
709+
Self.LacoEmFields;
710+
Self.GeraPrivate;
711+
FInterfaceGerada := False;
712+
Self.GeraPublic;
713+
FStrGeral.Add('implementation');
714+
Self.InstanciaFactoryMethod;
715+
Self.GeraConstructor;
716+
Self.GeraDestructor;
717+
Self.ProcessaFuncoesAcesso;
718+
FStrGeral.Add('end.');
719+
mmLog.Lines.Add(FStrGeral.Text.TrimRight);
720+
721+
if(ckGravarArquivosPasta.Checked)then
722+
FStrGeral.SaveToFile(FDirSalvar + FUnitNome + '.pas');
723+
724+
end;
725+
726+
procedure TViewMain.GeraTopoClasseInterface;
727+
begin
728+
if(ckAddCabecalho.Checked)then
729+
FStrGeral.Add(TUtils.GerarCabecalhoArquivo);
730+
731+
FStrGeral.Add('unit ' + FUnitNome + ';');
732+
FStrGeral.Add('');
733+
FStrGeral.Add('interface');
734+
FStrGeral.Add('');
735+
FStrGeral.Add('Uses');
736+
FStrGeral.Add('i'+ FUnitNome +'_;');
737+
FStrGeral.Add('');
738+
FStrGeral.Add('');
739+
FStrGeral.Add('type');
740+
FStrGeral.Add(' '+ FClasseNome +' = class ( TInterfacedObject, i' + FUnitNome + ' )');
741+
end;
742+
646743
procedure TViewMain.GerarClassesTabela(AtableName: string);
647744
begin
648745
FTabelaName := AtableName;
@@ -696,9 +793,24 @@ procedure TViewMain.GeraTopo;
696793
TORM.SimpleORM:
697794
FStrGeral.Add(' [Tabela('+ QuotedStr(FTabelaName) +')]');
698795
end;
796+
699797
FStrGeral.Add(' '+ FClasseNome +' = class');
700798
end;
701799

800+
procedure TViewMain.GeraTopoInterface;
801+
begin
802+
if(ckAddCabecalho.Checked)then
803+
FStrGeral.Add(TUtils.GerarCabecalhoArquivo);
804+
805+
FStrGeral.Add('unit i' + FUnitNome + '_;');
806+
FStrGeral.Add('');
807+
FStrGeral.Add('interface');
808+
FStrGeral.Add('');
809+
FStrGeral.Add('type');
810+
FStrGeral.Add(' i'+ FClasseNome +' = interface ' );
811+
FstrGeral.Add('['''+GUIDToString(TGuid.NewGuid)+''']');
812+
end;
813+
702814
procedure TViewMain.LacoEmFields;
703815
var
704816
LFieldName: string;
@@ -727,12 +839,19 @@ procedure TViewMain.LacoEmFields;
727839
//METODO ACESSO
728840
case(FFormaAcesso)of
729841
TFormaAcesso.PropertyDireto,
730-
TFormaAcesso.PropertyGetSet:
731-
Self.ProcessaProperty(LFieldName, LFieldNameLB, LFieldTipo);
842+
TFormaAcesso.PropertyGetSet:
843+
Self.ProcessaProperty(LFieldName, LFieldNameLB, LFieldTipo);
732844
TFormaAcesso.GetSet:
733-
Self.ProcessaGetSet(LFieldNameLB, LFieldTipo);
845+
Self.ProcessaGetSet(LFieldNameLB, LFieldTipo);
734846
TFormaAcesso.FluentInterface:
735-
Self.ProcessaFluentInterface(LFieldNameLB, LFieldTipo);
847+
Self.ProcessaFluentInterface(LFieldNameLB, LFieldTipo);
848+
TFormaAcesso.OrientadoInterface:
849+
begin
850+
if not FInterfaceGerada then
851+
Self.ProcessarContratoInterface( LFieldNameLB, LFieldTipo);
852+
if FInterfaceGerada then
853+
Self.ProcessaOrientacaoInterface(LFieldNameLB, LFieldTipo);
854+
end;
736855
end;
737856
dm.FDMetaInfoQueryFIelds.Next;
738857
end;
@@ -805,6 +924,11 @@ procedure TViewMain.ProcessaGetSetImplementacao(AFieldNameLB: string; AFieldTipo
805924
FStrAcessoImpl.Add('');
806925
end;
807926

927+
procedure TViewMain.ProcessarContratoInterface(AFieldNameLB: string; AFieldTipo: string);
928+
begin
929+
FStrAcessoDeclaracoes.Add(' function '+ AFieldNameLB +'(Value: '+ AFieldTipo +'): i' + FUnitNome + ';');
930+
end;
931+
808932
procedure TViewMain.ProcessaFluentInterface(AFieldNameLB: string; AFieldTipo: string);
809933
begin
810934
FStrAcessoDeclaracoes.Add(' function '+ AFieldNameLB +': '+ AFieldTipo +'; overload;');
@@ -823,6 +947,19 @@ procedure TViewMain.ProcessaFluentInterface(AFieldNameLB: string; AFieldTipo: st
823947
FStrAcessoImpl.Add('');
824948
end;
825949

950+
procedure TViewMain.ProcessaOrientacaoInterface(AFieldNameLB: string; AFieldTipo: string);
951+
begin
952+
953+
FStrAcessoDeclaracoes.Add(' function '+ AFieldNameLB +'(Value: '+ AFieldTipo +'): i' + FUnitNome +';');
954+
955+
FStrAcessoImpl.Add('function '+ FClasseNome +'.'+ AFieldNameLB +'(Value: '+ AFieldTipo +'): i'+ FUnitNome +';');
956+
FStrAcessoImpl.Add('begin');
957+
FStrAcessoImpl.Add(' Result := Self;');
958+
FStrAcessoImpl.Add(' F'+ AFieldNameLB +' := Value;');
959+
FStrAcessoImpl.Add('end;');
960+
FStrAcessoImpl.Add('');
961+
end;
962+
826963
procedure TViewMain.GeraPrivate;
827964
begin
828965
FStrGeral.Add(' private');
@@ -833,10 +970,35 @@ procedure TViewMain.GeraPrivate;
833970

834971
procedure TViewMain.GeraPublic;
835972
begin
836-
FStrGeral.Add(' public');
837-
FStrGeral.Add(' constructor Create;');
838-
FStrGeral.Add(FStrAcessoDeclaracoes.Text.TrimRight);
839-
FStrGeral.Add(' end;');
973+
if rdGroupFormaAcessoEntities.ItemIndex = 4 then
974+
begin
975+
if not FInterfaceGerada then
976+
begin
977+
FStrGeral.Add(' public');
978+
FStrGeral.Add(' constructor Create;');
979+
FStrGeral.Add(' destructor destroy ; Override;');
980+
FStrGeral.Add(' class function new: i' + FUnitNome + ';' );
981+
end;
982+
983+
FStrGeral.Add(FStrAcessoDeclaracoes.Text.TrimRight);
984+
FStrGeral.Add(' end;');
985+
FStrGeral.Add('');
986+
end
987+
else
988+
begin
989+
FStrGeral.Add(FStrAcessoDeclaracoes.Text.TrimRight);
990+
FStrGeral.Add(' end;');
991+
FStrGeral.Add('');
992+
end;
993+
end;
994+
995+
procedure TViewMain.InstanciaFactoryMethod;
996+
begin
997+
FStrGeral.Add('');
998+
FStrGeral.Add('class function '+ FClasseNome + '.new: i' + FUnitNome + ';');
999+
FStrGeral.Add('begin');
1000+
FStrGeral.Add(' Result := ' + FClasseNome + '.Create;');
1001+
FStrGeral.Add('end;');
8401002
FStrGeral.Add('');
8411003
end;
8421004

@@ -850,12 +1012,27 @@ procedure TViewMain.GeraConstructor;
8501012
FStrGeral.Add('');
8511013
end;
8521014

1015+
procedure TViewMain.GeraDestructor;
1016+
begin
1017+
FStrGeral.Add('');
1018+
FStrGeral.Add('Destructor '+ FClasseNome + '.Destroy;');
1019+
FStrGeral.Add('begin');
1020+
FStrGeral.Add(' inherited;');
1021+
FStrGeral.Add('end;');
1022+
FStrGeral.Add('');
1023+
end;
1024+
8531025
procedure TViewMain.ProcessaFuncoesAcesso;
8541026
begin
8551027
case(FFormaAcesso)of
8561028
TFormaAcesso.PropertyGetSet,
857-
TFormaAcesso.GetSet,
858-
TFormaAcesso.FluentInterface:
1029+
TFormaAcesso.GetSet,
1030+
TFormaAcesso.FluentInterface:
1031+
begin
1032+
FStrGeral.Add(FStrAcessoImpl.Text.TrimRight);
1033+
FStrGeral.Add('');
1034+
end;
1035+
TFormaAcesso.OrientadoInterface:
8591036
begin
8601037
FStrGeral.Add(FStrAcessoImpl.Text.TrimRight);
8611038
FStrGeral.Add('');

0 commit comments

Comments
 (0)