Delphi Construction de composant

par ajout d'un méthode
 (CD-ROMDelphi.composants\Methode.tree\
outline0.sans; outline1.avant; outline2.apres)


: retour aux composants Delphi          retour au chapitre 7

Objectif : construire un programme, puis une classe et enfin un composant Delphi qui implantent exactement les fonctionnalités de la nouvelle procédure d'affichage de toutes les branches de même niveaux d'un composant arbre déjà existant (nouvelle action et future méthode) et  tester son fonctionnement :
 

La fiche principale
 

Etape de construction n°0, le programme associé dans la unit
Etape de construction n°1 ( la classe).
Etape de construction n°2 (le composant).


Exécuter le programme.


  Classe mère dont on dérive : 

     Le composant visuel ToutLine déposé: 

La fiche principale du  projet :


 

Le code de la Unit fiche principale :
unit Ucompo00;
{Etape 0 : programme Delphi classique}

interface               // voir la  classe  dans l'étape suivante plus bas.

uses
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Grids, Outline;

type
  TForm1 = class(TForm)
    Outline1: TOutline;
    RadioGrouplevel: TRadioGroup;
    procedure RadioGrouplevelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations private }
  public
    { Déclarations public }
  end;

var
  Form1: TForm1;
  app_path:string;

implementation

{$R *.DFM}
{------------ procédures d'actions nouvelles sur le Toutline -----------}
procedure affiche_racine(tree:TOutline);
{remonte à la racine d'où que l'on soit}
var num_lev:integer;
begin
 if tree.Itemcount<>0 then  // voir la classe dans l'étape suivante plus bas.
 begin
  num_lev:=tree.items[tree.selecteditem].topItem;
  tree.SelectedItem:=tree.items[num_lev].parent.index;
  tree.items[1].expanded:=false;
 end
end;

procedure lire_un_niveau(rac:Toutline;indice:integer;niveau:integer);
{descente recursive en préordre sur un outline}
var node:ToutlineNode; {pour simplifier les manipulations}
    indice_node_fils,indice_node_pere:integer;
begin
if (indice<>-1)and(rac.ItemCount<>0) then
begin
 node:=rac.items[indice];      // voir la classe dans l'étape suivante plus bas.
 indice_node_pere:=rac.items[indice].parent.index;
 indice_node_fils:=indice;
 if node.HasItems then  {il y a des descendants}
 begin
  if node.level<=niveau then {uniquement si le niveau est correct}
  begin
   node.expand;             {visualiser les descendants à level+1}
   indice_node_pere:= rac.SelectedItem; {le noeud est le père}
   rac.SelectedItem:=rac.Items[rac.SelectedItem].GetFirstChild; {le 1er à gauche}
   indice_node_fils:=rac.SelectedItem;  {indice du noeud fils gauche}
   if indice_node_fils<>-1 then
   begin
    lire_un_niveau(rac,indice_node_fils,niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils);{indice du frère suivant}
   end;
   while indice<>-1 do {examen de tous les frères de indice_node_fils}
   begin
    rac.SelectedItem:=indice;         {le frère suivant}
    indice_node_fils:=rac.SelectedItem; {le frère suivant est le nouveau fils}
    lire_un_niveau(rac,indice_node_fils,niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils); {indice du frère suivant}
   end
  end
 end
end
end;

procedure affiche_un_niveau(le_niveau:integer);
{pour visualiser tout le niveau choisi par l'utilisateur}
var
 indice_noeud:integer;
 begin
 affiche_racine(form1.Outline1);
 if le_niveau<>0 then
 begin
  indice_noeud:= form1.Outline1.selecteditem;   // voir la classe dans l'étape suivante plus bas.
  lire_un_niveau(form1.Outline1,indice_noeud,le_niveau);
  if form1.Outline1.Itemcount<>0 then
  begin
   indice_noeud:=form1.Outline1.Items[1].GetNextChild(indice_noeud);
   while indice_noeud<>-1 do
   begin
    form1.Outline1.selecteditem:=indice_noeud;
    lire_un_niveau(form1.Outline1,indice_noeud,le_niveau);
    indice_noeud:=form1.Outline1.Items[1].GetNextChild(indice_noeud);
   end
  end
 end
end;
 {------------------------------------------------------------------------}
{////////////////////// Gestionnaires d'événements //////////////////////}

procedure TForm1.RadioGrouplevelClick(Sender: TObject);
var
 level_click:integer;
begin
 level_click:=RadioGrouplevel.Itemindex;
 Form1.caption:=' Structure abstraite générale - Profondeur choisie : '+inttostr(level_click);
 affiche_un_niveau(level_click);  {appel de la procédure d'action}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   app_path:=ExtractFilePath(Application.ExeName);
   Outline1.lines.LoadFromfile(app_path+'lines.txt'); {arbre chargé}
end;
end.                 Remonter 


La classe développée :

Création d'une classe à partir de l'étape précédente n°0, avec un programme d'utilisation d'une instance de cette classe afin de la tester.

unit Ucompo01; 
{Etape 1 : programme Delphi avec une classe}
interface

uses
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Grids, Outline;
type
  TTree2 = class(TOutline)  {la nouvelle classe TTree2 dérivée de Toutline}
  private
    { Déclarations private }
  public
    { Déclarations public }
    procedure affiche_un_niveau(le_niveau:integer); {méthode publique}
  end;

  TForm1 = class(TForm)
    RadioGrouplevel: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure RadioGrouplevelClick(Sender: TObject);
  private
    { Déclarations private }
  public
    { Déclarations public }
  end;

var
  Form1: TForm1;
  app_path:string;
  new_compos:TTree2;  {objet TTree2 instancié}

implementation

{$R *.DFM}
{------------ procédures d'actions sur le TTree2 -----------}
procedure affiche_racine(tree:TTree2);
{remonte à la racine d'où que l'on soit.
Code identique à l'étape 0 }
var num_lev:integer;
begin
 if tree.Itemcount<>0 then
 begin
  num_lev:=tree.items[tree.selecteditem].topItem;
  tree.SelectedItem:=tree.items[num_lev].parent.index;
  tree.items[1].expanded:=false;
 end
end;

procedure lire_un_niveau(rac:TTree2;indice:integer;niveau:integer);
{descente recursive en préordre sur un outline.
Code identique à l'étape 0 }
{descente recursive en préordre sur un outline}
var node:ToutlineNode; {pour simplifier les manipulations}
    indice_node_fils,indice_node_pere:integer;
begin
if (indice<>-1)and(rac.ItemCount<>0) then
begin
 node:=rac.items[indice];      // voir la classe dans l'étape suivante plus bas.
 indice_node_pere:=rac.items[indice].parent.index;
 indice_node_fils:=indice;
 if node.HasItems then  {il y a des descendants}
 begin
  if node.level<=niveau then {uniquement si le niveau est correct}
  begin
   node.expand;             {visualiser les descendants à level+1}
   indice_node_pere:= rac.SelectedItem; {le noeud est le père}
   rac.SelectedItem:=rac.Items[rac.SelectedItem].GetFirstChild; {le 1er à gauche}
   indice_node_fils:=rac.SelectedItem;  {indice du noeud fils gauche}
   if indice_node_fils<>-1 then
   begin
    lire_un_niveau(rac,indice_node_fils,niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils);{indice du frère suivant}
   end;
   while indice<>-1 do {examen de tous les frères de indice_node_fils}
   begin
    rac.SelectedItem:=indice;         {le frère suivant}
    indice_node_fils:=rac.SelectedItem; {le frère suivant est le nouveau fils}
    lire_un_niveau(rac,indice_node_fils,niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils); {indice du frère suivant}
   end
  end
 end
end
end; 

{--------------------  Méthode de la classe TTree2  ---------------------}
procedure TTree2.affiche_un_niveau(le_niveau:integer);
{pour visualiser tout le niveau choisi par l'utilisateur.
form1.Outline1 de l'étape 0, a été remplacé par "self"}
var
 indice_noeud:integer;
 begin
 affiche_racine(self);
 if le_niveau<>0 then
 begin
  indice_noeud:= self.selecteditem;
  lire_un_niveau(self,indice_noeud,le_niveau);
  if self.Itemcount<>0 then
  begin
   indice_noeud:=self.Items[1].GetNextChild(indice_noeud);
   while indice_noeud<>-1 do
   begin
    self.selecteditem:=indice_noeud;
    lire_un_niveau(self,indice_noeud,le_niveau);
    indice_noeud:=self.Items[1].GetNextChild(indice_noeud);
   end
  end
 end
end;

{------------------------------------------------------------------------}
{////////////////////// Gestionnaires d'événements //////////////////////}

procedure TForm1.FormCreate(Sender: TObject);
{Les différences avec l'étape 0 portent essentiellement
sur l'instanciation d'un objet de la classe TTree et
son positionnement sur la fiche.}
begin
 app_path:=ExtractFilePath(Application.ExeName);
 new_compos:=TTree2.create(self); {objet TTree2 créé}
 new_compos.parent:=self;        {objet TTree2 affichable}
 new_compos.setbounds(8,8,233,233); {position : left,top,width,height}
 new_compos.lines.loadfromfile(app_path+'lines.txt');  {arbre chargé}
end;

procedure TForm1.RadioGrouplevelClick(Sender: TObject);
{pour visualiser tout le niveau choisi par l'utilisateur}
var
 level_click:integer;
begin
 level_click:=RadioGrouplevel.Itemindex;
 Form1.caption:=' Structure abstraite générale - Profondeur choisie : '+inttostr(level_click);
 new_compos.affiche_un_niveau(level_click);  {appel de méthode de l'objet}
end;



Le nouveau composant :

Création d'un composant à partir de l'étape précédente n°1; la classe est transformée en composant en reprenant intégralement son code source et en ajoutant le "constructor" de la nouvelle classe.
 

unit Utree2; 
{Etape 2 : un composant à partir de la classe}

interface

uses
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, ExtCtrls, Outline;

type
  TTree2 = class(TOutline)
  private
    { Déclarations private }
  public
    { Déclarations public }
    constructor Create(Aowner:Tcomponent);override;
    procedure affiche_un_niveau(le_niveau:integer);
  end;

procedure register;

implementation

procedure register;
begin
 RegisterComponents('Perso',[TTree2])
end;
{///////////////////////////////////////////////////////////////////////////}
{------- procédures internes au TTree2 ----------}

procedure affiche_racine(tree:TTree2);
{remonte à la racine d'où que l'on soit
Code identique à l'étape 1}
var num_lev:integer;
begin
 if tree.Itemcount<>0 then
 begin
  num_lev:=tree.items[tree.selecteditem].topItem;
  tree.SelectedItem:=tree.items[num_lev].parent.index;
  tree.items[1].expanded:=false;
 end
end;

procedure lire_un_niveau(rac:TTree2;indice:integer;le_niveau:integer);
{descente recursive en préordre sur un outline
Code identique à l'étape 1}
var
    node:ToutlineNode; {pour simplifier les manipulations}
    indice_node_fils,indice_node_pere:integer;
begin
if (indice<>-1)and(rac.Itemcount<>0) then
begin
 node:=rac.items[indice];
 indice_node_pere:=rac.items[indice].parent.index;
 indice_node_fils:=indice;
 if node.HasItems then  {il y a des descendants}
 begin
  if node.level<=le_niveau then {uniquement si le niveau est correct}
  begin
   node.expand;             {visualiser les descendants à level+1}
   indice_node_pere:= rac.SelectedItem; {le noeud est le père}
   rac.SelectedItem:=rac.Items[rac.SelectedItem].GetFirstChild; {le 1er à gauche}
   indice_node_fils:=rac.SelectedItem;  {indice du noeud fils gauche}
   if indice_node_fils<>-1 then
   begin
    lire_un_niveau(rac,indice_node_fils,le_niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils);{indice du frère suivant}
   end;
   while indice<>-1 do {examen de tous les frères de indice_node_fils}
   begin
    rac.SelectedItem:=indice;          {le frère suivant}
    indice_node_fils:=rac.SelectedItem; {le frère suivant est le nouveau fils}
    lire_un_niveau(rac,indice_node_fils,le_niveau);
    indice:=rac.Items[indice_node_pere].GetNextChild(indice_node_fils); {indice du frère suivant}
   end
  end
 end
end;
end;
{--------------------  Méthode de la classe TTree2  ---------------------}
procedure TTree2.affiche_un_niveau(le_niveau:integer);
{pour visualiser tout le niveau choisi par l'utilisateur.
Code identique à celui de l'étape 1}
var
 indice_noeud:integer;
 begin
 affiche_racine(self);
 if le_niveau<>0 then
 begin
  indice_noeud:= self.selecteditem;
  lire_un_niveau(self,indice_noeud,le_niveau);
  if self.Itemcount<>0 then
  begin
   indice_noeud:=self.Items[1].GetNextChild(indice_noeud);
   while indice_noeud<>-1 do
   begin
    self.selecteditem:=indice_noeud;
    lire_un_niveau(self,indice_noeud,le_niveau);
    indice_noeud:=self.Items[1].GetNextChild(indice_noeud);
   end
  end
 end
end;

{/////////////////////////  CONSTRUCTEUR  ////////////////////////////}
constructor TTree2.Create(Aowner:Tcomponent);
{remplace le create dans l'étape 1}
begin
 inherited create(Aowner);
 self.setbounds(8,8,233,233); {position : left,top,width,height}
end;

end.


EXECUTION DU PROGRAMME :