Simplification d'une procédure

**BuzzLeclaire** · 17/04/2009, 09h53

Bonjour à toutes et à tous...

J'aurais besion de simplifier cette procédure si c'est possible.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
procedure TFSociete.FormCreate(Sender: TObject);
Var
  xLabel: TLabel;
  xGrpBox: TJvGroupBox;
  xTabsheet: TTabSheet;
begin
  With DataModule1.ADOQry do
  Begin
    Try
      Try
        SQL.Clear;
        SQL.Add('Select * From SysFiches ');
        SQL.Add('Where Fiche= :xFiche');
        Parameters.ParamByName('xFiche').Value := Self.Name;
        Open;
        While not eof do
        Begin
          if Fields.FieldByName('Composant').AsString = 'Tlabel' then
          Begin
            xLabel := TLabel(Self.FindComponent(Fields.FieldByName('Name').AsString));
            if Assigned(xLabel) then xLabel.Caption := Fields.FieldByName('Libelle').AsString;
          end
          else
            if Fields.FieldByName('Composant').AsString = 'Tform' then Self.Caption := Fields.FieldByName('Libelle').AsString
            else
              if Fields.FieldByName('Composant').AsString = 'TjvGroupBox' then
              Begin
                xGrpBox := TJvGroupBox(Self.FindComponent(Fields.FieldByName('Name').AsString));
                if Assigned(xGrpBox) then xGrpBox.Caption := ' '+Fields.FieldByName('Libelle').AsString+' ';
              end
              else
                if Fields.FieldByName('Composant').AsString = 'TTabSheet' then
                Begin
                  xTabsheet := TTabSheet(Self.FindComponent(Fields.FieldByName('Name').AsString));
                  if Assigned(xTabsheet) then xTabsheet.Caption :=Fields.FieldByName('Libelle').AsString;
                end;
          next;
        end;
      Except
        on E : Exception do
        Begin
          ShowMessage('Mon Message d''erreur ');
        End;
      end;
    finally
      Close;
    end;
  end;
// ...
end;

comment peut-on faire pour eviter de déclarer les variables :
xLabel: TLabel;
xGrpBox: TJvGroupBox;
xTabsheet: TTabSheet;

en simplifiant en une variable, est-ce possible ?

En fait je suis obligé de faire 4 tests car le type Tlabel, TJvGroupBox, TTabsheet ou TForm n'est pas le même

if Fields.FieldByName('Composant').AsString = 'Tlabel'
if Fields.FieldByName('Composant').AsString = 'Tform'
if Fields.FieldByName('Composant').AsString = 'TjvGroupBox'
if Fields.FieldByName('Composant').AsString = 'TTabSheet'

Pourrait-on imaginer :
if Fields.FieldByName('Composant').AsString = Composant trouver sur la fiche
etc..

Merci de votre aide...

**Andnotor** · 17/04/2009, 10h51

Si tous les composants dérivent de TControl, tu pourrais imaginer quelque chose comme ceci. Le seul cas particulié est la fiche.
Stocker le type de composant dans la base deviendrait aussi inutile

.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
//Permet d'accéder au TControl.Caption (Protected)
type
  TControlEx = class(TControl);
 
procedure TFSociete.FormCreate(Sender: TObject);
Var
  Control :TControlEx;
begin
  With DataModule1.ADOQry do
  Begin
    SQL.Text := 'Select * From SysFiches Where Fiche= :xFiche';
    Parameters.ParamByName('xFiche').Value := Self.Name;
    Open;
 
    While not eof do
    Begin
      //Fiche...
      if AnsiSameText(FieldByName('Name').AsString, Self.Name) then
        Self.Caption := FieldByName('Libelle').AsString
 
      //...autres contrôles
      else
        //Exception si le composant n'est pas un TControl, mais ne renvoi
        //pas de message d'erreur. le composant est simplement ignoré !
        try
          Control := TControlEx(Self.FindComponent(FieldByName('Name').AsString));
          if Assigned(Control) then
            Control.Caption := FieldByName('Libelle').AsString;
        except end;
 
      Next;
    end;
 
    Close;
  end;
// ...
end;

Deuxième variante en énumérant les controles de la fiche et en cherchant dans la base:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
//Permet d'accéder au TControl.Caption (Protected)
type
  TControlEx = class(TControl);
 
procedure TFSociete.FormCreate(Sender: TObject);
var
  i :integer;
begin
  With DataModule1.ADOQry do
  Begin
    SQL.Clear;
    SQL.Add('Select * From SysFiches ');
    SQL.Add('Where Fiche= :xFiche');
    Parameters.ParamByName('xFiche').Value := Self.Name;
    Open;
 
    //Fiche...
    if Locate('Name', Self.Name, []) then
      Self.Caption := FieldByName('Libelle').AsString;
 
    //...autres contrôles
    for i := 0 to ComponentCount -1 do
      if Components[i] is TControl then
        if Locate('Name', Components[i].Name, []) then
          TControlEx(Components[i]).Caption := FieldByName('Libelle').AsString;
 
    Close;
  end;
// ...
end;

**khaled-benloucif** · 17/04/2009, 11h06

salut,
moi j'utilise le TActionList, il supporte la propriété Caption, Enabled et Visible. tu peux déjà centraliser tout tes taitements dans des Actions et les lier avec les objets de la VCL qui comporte la propriété Action. de cette manière tu parcoures seulement la propriété Actions pour localiser ton objet au lieu de faire un FindComponent sur tous les objets présents dans la fiche. Pour les autres objets qui n'ont pas de propriété Action, faut les traiter séparément.

jette un coup d'œil ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 
procedure TMainForm.LoadUserProfile;
var
	I: Integer;
	Trans: TpFibTransaction;
	ObjFound: Boolean;
begin
 with TpFIBDataSet.Create(Application) do
	try
	 Trans:= TpFibTransaction.Create(Application);
	 DataBase:= _DataBase;
	 Transaction:= Trans;
	 Trans.DefaultDatabase:= MainForm.pFIBDatabase1;
	 Trans.Active:= true;
	 Params.Count:= 1;
	 with Sqls.SelectSQL do
		begin
			Clear;
			Add('SELECT');
			Add('OBJ_PRNT,');
			Add('OBJ_NAME,');
			Add('OBJ_CLASS,');
			Add('ACTN_VISIBLE,');
			Add('ACTN_ENABLED,');
			Add('USER_GRP');
			Add('FROM GET_USER_INTERFACE_ROLES(:USER_NAME)');
			Add('WHERE OBJ_CLASS in (3, 4)');
		end;
	 Params.ParamByName('user_name').AsString:= fCurrentUser;
	 Active:= true;
	 First;
	 while not Eof do
		begin
		 ObjFound:= false;
		 if FieldByName('OBJ_CLASS').AsInteger= 3 then// TAction
			begin
			 with ActionList_S do
				for I:= 0 to ActionCount- 1 do
				 with TAction(Actions[I]) do
					if Name= FieldByName('OBJ_NAME').AsString then
					 begin
						Visible:= (FieldByName('ACTN_VISIBLE').AsInteger= 255) and (Tag and $1=$1);
						Enabled:= (FieldByName('ACTN_ENABLED').AsInteger= 255) and (Tag and $2=$2);
						UpdateAction(Actions[I]);
						ObjFound:= true;
						Break
					 end;
			 if not ObjFound then
				with ActionList_L do
				 for I:= 0 to ActionCount- 1 do
					with TAction(Actions[I]) do
					 if Name= FieldByName('OBJ_NAME').AsString then
						begin
						 Visible:= (FieldByName('ACTN_VISIBLE').AsInteger= 255) and (Tag and $1=$1);
						 Enabled:= (FieldByName('ACTN_ENABLED').AsInteger= 255) and (Tag and $2=$2);
						 UpdateAction(Actions[I]);
						 Break
						end
			end
		 else 
			if FieldByName('OBJ_CLASS').AsInteger= 4 then// dxBar
			 with dxBarManager do
				for I:= 0 to Bars.Count- 1 do
				 if (Bars[I].Name= FieldByName('OBJ_NAME').AsString) then
					with Bars[I] do
					 begin
						Visible:= (FieldByName('ACTN_VISIBLE').AsInteger= 255) and (Tag and $1=$1);
						Break
					 end;
		 Next
		end;
	finally
	 Free;
	 Trans.Free
	end;
end;

sauf qu'ici je manipule la propriété Enabled et Visible au lieu de Caption

**Cl@udius** · 17/04/2009, 11h18

Oops j'ai été grillé sur ce coup là.

J'ai abouti au même code qu'Andnotor.

Cependant comme j'ai horreur des exceptions silencieuses j'ai plutôt fait ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TFSociete.FormCreate(Sender: TObject);
Var
  Compo: TComponent;
begin
  // ...
        else
        begin
          Compo := Self.FindComponent(FieldByName('Name').AsString);
          if Assigned(Compo) and (Compo is TControl) then
            TControlEx(Compo).Caption := FieldByName('Libelle').AsString;
        end;
        Next;
  // ...
end;

Mais bon, c'est juste histoire de contrarier HAL.

@+ Claudius

**Andnotor** · 17/04/2009, 11h21

HAL n'en prendra pas ombrage

.
J'étais aussi en train d'éditer une variante comme la tienne

.

Après Laurel et Hardy, voici Ping et Pong...

**Kaféine** · 17/04/2009, 14h52

Salut,

Je vous propose ma variante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
uses TypInfo;
 
procedure TFSociete.FormCreate(Sender: TObject);
 
  procedure UpdateCaption(AName: string; ANewCaption: string);
  var
    C: TComponent;
    P: PPropInfo;
  begin
    C := FindComponent(AName);
    if C = nil then C := Application.FindComponent(AName);
    if C <> nil then
    begin
      P := GetPropInfo(C, 'Caption');
      if P <> nil then
        SetStrProp(C, 'Caption', ANewCaption);
    end;
  end;
 
begin
  (...)
  while not Qry.Eof do
  begin
    UpdateCaption(Qry.FieldByName('Name').AsString, Qry.FieldByName('Libelle').AsString);
    Qry.Next;
  end;
end;

**Just-Soft** · 18/04/2009, 10h07

Visiblement c'est FindComponent qui l'emporte

**BuzzLeclaire** · 18/04/2009, 11h27

Je vous remercie de toutes vos propositions, pour vous répondre à chacun d'entre vous :

@khaled-benloucif : J'ai parcourus visuellement ta proposition qui ne rentre pas exactement dans ma demande, je te remercie tout de même.

@Kaféine : Une belle piste qui va peut-être m'aider pour la suite de cette demande, car je souhaite en fait rendre cela accessible sous form de fonction...

@AndNotOr : Le coup de l'accès au caption protéger + le AnsiSametext, il n'ya pas grand chose à dire à part [Copier-Coller] dans mon programme... Toujours aussi pertinent...

@Cl@udius : Ton adaptation à cloturer (si je puis dire) mon besoin.

Voilà ce que j'ai retenue après différents test :
Un mélange de AndNotOr + Cl@udius, et une toute petit correction de ma part :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
unit Societe;
 
interface
 
uses
// ....
 
type
  TControlEx = class(TControl);
 
type
  TFSociete = class(TForm)
// ...
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  FSociete: TFSociete;
 
implementation
 
// ...
 
{$R *.dfm}
 
procedure TFSociete.FormCreate(Sender: TObject);
Var
  xCompo: TComponent;
begin
  xCompo := Nil;
  With DataModule1.ADOQry do
  Begin
    Try
      Try
        SQL.Clear;
        SQL.Add('Select * From SysFiches ');
        SQL.Add('Where Fiche= :xFiche');
        Parameters.ParamByName('xFiche').Value := Self.Name;
        Open;
        While not eof do
        Begin
          if AnsiSameText(FieldByName('Name').AsString, Self.Name) then
            Self.Caption := FieldByName('Libelle').AsString
          else
            xCompo := Self.FindComponent(FieldByName('Name').AsString);
            if Assigned(xCompo) and (xCompo is TControl) then
              TControlEx(xCompo).Caption := FieldByName('Libelle').AsString;
          next;
	end;
      Except
        on E : Exception do
        Begin
          ShowMessage(E.ClassName + ' erreur soulevée : '+#13+#10+
          'Message : '  + E.Message       +#13+#10+
          'Unit : '     + 'Societe'  +#13+#10+
          'Procedure : '+ 'FormCreate'      +#13+#10+
          '-----------------------------------------------------------------------'+#13+#10+
          'Impossible d''initialiser la fenêtre.'+#13+#10+
          'Si le problème persiste, avertissez votre revendeur de ce message.');
        End;
      end;
    finally
      Close;
    end;
  end;
end;

xCompo := Nil est ma contribution sur ma demande, afin d'éviter une alerte par Delphi.

PS : Je n'ai pas souhaiter utiliser le components.count (trop long à mon gout)

Chapeau à vous Tous et merci grandement.

Maintenant j'aimerais aller plus loin dans la simplification de ma procédure. En fait j'utilise un vingtaine de form qui vont toute au create utiliser cette procédure. Est-il possible d'utiliser une fonction (placer dans un .PAS que j'utilise en commun) et d'affecter les TControl propre à la fenêtre ouverte ?

**Cl@udius** · 18/04/2009, 11h39

Envoyé par BuzzLeclaire

Maintenant j'aimerais aller plus loin dans la simplification de ma procédure. En fait j'utilise un vingtaine de form qui vont toute au create utiliser cette procédure. Est-il possible d'utiliser une fonction (placer dans un .PAS que j'utilise en commun) et d'affecter les TControl propre à la fenêtre ouverte ?

Bien-sûr.

Déporte ce traitement dans une procédure placée dans ta nouvelle unité, exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Unit Unit2;
 
// ...
 
procedure InitForm(AForm: TForm);
begin
  // Ton traitement actuel en remplaçant Self par AForm.
end;

Et dans le Create des TForm:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Uses
  Unit2;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  InitForm(Self);
end;

@+ Claudius

**BuzzLeclaire** · 18/04/2009, 11h50

Purée.. ca marche nikel. Pfff c'était pourtant simple...

Merci une nouvelle fois.

**Cl@udius** · 18/04/2009, 11h51

Envoyé par BuzzLeclaire

Purée.. ca marche nikel.

Cool

Simplification d'une procédure

Langage Delphi

Discussions similaires

Partager

Partager