Delphi Construction de composant

par ajout de nouvelles propriétés

            (CD-ROM Delphi.composants\Propriete.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 d'affichage de toutes les branches de même niveaux d'un composant arbre déjà existant, par ajout de 2 nouvelles propriétés au ToutLine ( une propriété de profondeur de l'arbre et une propriété permettant de voir l'arbre développé jusqu'à un niveau fixé).
 

La fiche principale, le code associé dans la unit.

Etape de construction n°2 ( la classe).
Etape de construction n°3 (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];
 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;
  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      // voir la classe dans l'étape suivante plus bas.
   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
  TTree1 = class(TOutline)  {la nouvelle classe TTree1 dérivée de Toutline}
  private
   Fniveau:integer;
   function Getmaxniveau:integer;                {méthode interne}
   procedure affiche_un_niveau(le_niveau:integer); {méthode interne}
public
    { Déclarations public }
    property profondeur:integer readGetmaxniveau;
    property show_niveau:integer read Fniveau write affiche_un_niveau;
  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:TTree1;  {objet TTree1 instancié}

implementation 

{$R *.DFM}
{------------ procédures d'actions sur le TTree1 -----------}
procedure affiche_racine(tree:TTree1);
{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:TTree1;indice:integer;niveau:integer);
{descente recursive en préordre sur un outline.
Code identique à l'étape 0 }
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<=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éthodes internes de la classe TTree1  -----------------}
procedure TTree1.affiche_un_niveau(le_niveau:integer);
{pour visualiser tout le niveau choisi par l'utilisateur.
On reprende le code de l'étape 1 de l'exemple "Methode.Tree",
le form1.outline1 est 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; 

function TTree1.Getmaxniveau:integer;
{donne la profondeur maximum de l'arbre
profondeur racine=0}
var i,max:integer;
begin
  if self.Itemcount<>0 then
  begin
   max:=1;
   for i:=1 to self.Itemcount do
    if max<self.Items[i].level then
     max:=self.Items[i].level;
   Getmaxniveau:=max-1;
  end
  else Getmaxniveau:=0
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 TTree1 et
son positionnement sur la fiche.}
begin
 app_path:=ExtractFilePath(Application.ExeName);
 new_compos:=TTree1.create(self);   {objet TTree1 créé}
 new_compos.parent:=self;         {objet TTree1 affichable}
 new_compos.setbounds(8,8,233,233); {position : left,top,width,height}
 new_compos.lines.loadfromfile(app_path+'lines.txt'); {arbre chargé}
 RadioGrouplevel.caption:='Prof.= '+Inttostr(new_compos.profondeur)
end;

procedure TForm1.RadioGrouplevelClick(Sender: TObject);
{tester et 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.show_niveau:=level_click; {modification de propriété de l'objet}
end;
 

end. 


Le nouveau composant :

    La classe TTree1 dérive du Toutline et contient deux propriétés nouvelles profondeur et show_niveau.
 

La unit contenant le composant :
unit Utree1;
{Etape 2 : un composant à partir de la classe}
interface
uses
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, ExtCtrls, Outline;

type
TTree1 = class(TOutline) {la nouvelle classe TTree1 dérivée de Toutline}
  private
   Fniveau:integer;
   function Getmaxniveau:integer;                 {méthode interne}
   procedure affiche_un_niveau(le_niveau:integer); {méthode interne}
  public
    constructor Create(Aowner:Tcomponent);override;
    property profondeur:integer readGetmaxniveau;
    property show_niveau:integer read Fniveau write affiche_un_niveau;
  end;

procedure register; 

implementation

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

procedure affiche_racine(tree:TTree1);
{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:TTree1;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éthodes internes de la classe TTree1  ---------------------}
procedure TTree1.affiche_un_niveau(le_niveau:integer);
{pour visualiser tout le niveau choisi par l'utilisateur}
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; 

function TTree1.Getmaxniveau:integer;
{renvoie la profondeur maximum de l'arbre profondeur de la racine=0}
var i,max:integer;
begin
  if self.Itemcount<>0 then
  begin
   max:=1;
   for i:=1 to self.Itemcount do
    if max<self.Items[i].level then
     max:=self.Items[i].level;
   Getmaxniveau:=max-1;
  end
  else Getmaxniveau:=0
end; 
{------------------------------------------------------------------------------------}
{//////////////////////////////  CONSTRUCTEUR  ////////////////////////////////////////}
constructor TTree1.Create(Aowner:Tcomponent);
begin
 inherited create(Aowner);
 self.setbounds(8,8,233,233); {position : left,top,width,height}
end;

end. 


EXECUTION DU PROGRAMME :