Delphi Construction de composant

par modification d'un évènement

(CD-ROM Delphi.composants\Evenement.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 en reprenant les adjonctions de nouvelles propriétés(profondeur de l'arbre et développement de l'arbre jusqu'à un niveau fixé); le plus est apporté ici par une modification de l'évènement OnMouseDowndu Toutline (à partir d'un clic du bouton droit de souris sur un noeud ou sur une feuille de l'arbre développé, l'arbre est refermé et seul le chemin d'accès au noeud cliqué est affiché avec l'envoi d'un signal sonore d'avertissement). Attention avant d'entreprendre cet exercice, bien se familiariser avec les deux exercices : ajout de méthode ou ajout de propriété sur un Toutline.

La fiche principale,

Etape de construction n°1 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 :
(reprise du code déjà explicité dans l'exemple ajout de propriétés)

unit Ucompo00;
{Etape 0 : programme Delphi classique}

interface // voir la classedans 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);
    procedure Outline1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
private
    { Déclarations private }
public
    { Déclarations public }
end;

var
Form1: TForm1;
app_path:string;

implementation
// on ajoute une procédure (modèle de la future méthode), et un gestionnaire de l'évènement OnMouseDown (modèle de la future réaction automatique du composant au clic droit de souris)

{$R *.DFM}
{------------ ajout d'une future méthode supplémentaire ---------------}

procedure CalCulChemin(Noeud:ToutLineNode;Liste:TstringList);
{stockage dans une TstringList du chemin des numéros
de noeuds depuis la racine jusqu'à "Noeud" }
begin
if Noeud.index<>1 then {on ne remonte pas au delà de la racine!}
begin
Liste.add(inttostr(Noeud.parent.index));
CalCulChemin(Noeud.parent,Liste)
end
end;

{------- future modification de l'évènement OnMouseDown -------}
procedure TForm1.Outline1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var numItem,i:integer;
begin
with Sender as TOutLine do
begin
numItem:=selecteditem;
if Button=mbRight then
begin
    MessageBeep(MB_ICONASTERISK); {exemple de fonction de l'API Windows}
    ListeChemin.clear;         {RAZ liste précédente}
    CalCulChemin(items[numItem],ListeChemin);
    items[1].Collapse;          {fermeture de tout l'arbre}
    for i:=ListeChemin.count-1 downto 0 do
     Items[strtoint(ListeChemin[i])].expand; {expansion des parents seulement}
end
end
end;

LE RESTE DU CODE EST IDENTIQUE A AJOUT DE PROPRIETES.

end. Remonter

La classe développée :

Création d'une classe à partir de l'étape précédente n°0.

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

interface

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

type
TTree3 = class(TCustomControl)
{Attention : la nouvelle classe TTree3 est dérivée de TCustomControl, car il n'est pas possible d'associer directement et simplement dans une classe dérivée de Toutline le gestionnaire de l'événement OnMouseDown. L'événement n'est pas surchargeable.}
private
   Fniveau:integer;
   FArbre:Toutline;
   function Getmaxniveau:integer;               {méthode interne}
   procedure affiche_un_niveau(le_niveau:integer); {méthode interne}
procedure CalCulChemin(Noeud:ToutLineNode;Liste:TstringList);{méth. interne}
public
    { Déclarations public }
    ListeChemin:TStringList;
    constructor Create(AOwner: TComponent);override;
procedure MouseDownSurArbre(Sender: TObject; {gestionnaire OnMouseDown}
              Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    property profondeur:integer read Getmaxniveau;
    property show_niveau:integer read Fniveau write affiche_un_niveau;
    property Arbre:Toutline read FArbre write FArbre; {arbre accessible}
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:TTree3; {objet TTree3 instancié}

implementation

{$R *.DFM}
{------------ procédures d'actions sur le TTree3 -----------}
TOUT LE CODE EST IDENTIQUE A AJOUT DE PROPRIETES (classe).

{---------------- Méthodes internes de la classe TTree3 -----------------}

procedure TTree3.CalCulChemin(Noeud:ToutLineNode;Liste:TstringList);
{stockage dans une TstringList du chemin des numéros
de noeuds depuis la racine jusqu'à "Noeud" }
begin
if Noeud.index<>1 then {on ne remonte pas au delà de la racine!}
begin
Liste.add(inttostr(Noeud.parent.index));
CalCulChemin(Noeud.parent,Liste)
end
end;
RESTE DU CODE IDENTIQUE A AJOUT DE PROPRIETES(classe).

{-----//// Le gestionnaire de l'événement OnMouseDown //////-----}
//------------------------ sur le champ Arbre ---------------------------//

procedure TTree3.MouseDownSurArbre(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var numItem,i:integer;
begin
with Sender as TOutLine do
begin
numItem:=selecteditem;
if Button=mbRight then
begin
    MessageBeep(MB_ICONASTERISK); {function de l'API Windows}
    ListeChemin.clear;          {RAZ liste précédente}
    CalCulChemin(items[numItem],ListeChemin);
    items[1].Collapse;          {fermeture de tout l'arbre}
    for i:=ListeChemin.count-1 downto 0 do
     Items[strtoint(ListeChemin[i])].expand; {expansion des parents seulement}
end
end
end;

{///////////////////////// CONSTRUCTEUR ////////////////////////////}
// on associe l'évènement OnMouseDown à notre gestionnaire

constructor TTree3.Create(AOwner: TComponent);
begin
inherited create(Aowner);        {on hérite de tout, puis... :}
self.setbounds(8,8,233,240);      {position du CustomControl}
self.Arbre:=Toutline.create(self); {création outline}
self.Arbre.parent:=self;         {affichage fenêtré du outline}
self.Arbre.setbounds(8,8,233,240); {position du Outline dans le CustomControl}
self.Arbre.OnMouseDown:=MouseDownSurArbre;{association au gestionnaire}
self.ListeChemin:=TStringList.create;{création du TstringList}
end;

procedure TForm1.FormCreate(Sender: TObject);
{Les différences avec l'étape 0 portent essentiellement
sur l'instanciation d'un objet de la classe TTree3 et
son positionnement sur la fiche.}
begin
app_path:=ExtractFilePath(Application.ExeName);
new_compos:=TTree3.create(self); {objet TTree créé}
new_compos.parent:=self; {affichage fenêtré du TTree3}
new_compos.Arbre.lines.loadfromfile(app_path+'lines.txt'); {arbre chargé}
RadioGrouplevel.caption:='Prof.= '+Inttostr(new_compos.profondeur)
end;

RESTE DU CODE IDENTIQUE A AJOUT DE PROPRIETES(classe).

end.

Le nouveau composant :

Le composant "Utree3.pas" est élaboré à partir de classe TTree3 qui dérive du Toutline et contient un gestionnaire de l'évènement OnMouseDown. Par rapport à la classe, nous avons ajouté une propriété "publiée" (property Lignes:Tstrings) qui permet d'accéder aux lignes de chaînes de l'arbre inclus dans le composant.

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

interface

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

type
TTree3 = class(TCustomControl){strictement identique à l'étape 1}
private
   Fniveau:integer;
   Arbre:Toutline;
   function Getmaxniveau:integer;                {méthode interne}
   function Getlignes:Tstrings;                 {méthode interne}
   procedure Setlignes(x:Tstrings);              {méthode interne}
   procedure affiche_un_niveau(le_niveau:integer); {méthode interne}
   procedure CalCulChemin(Noeud:ToutLineNode;Liste:TstringList);{méth. interne}
   procedure MouseDownSurArbre(Sender: TObject; {gestionnaire OnMouseDown}
              Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
    { Déclarations public }
    ListeChemin:TStringList;
    constructor Create(AOwner: TComponent);override;
    property profondeur:integer read Getmaxniveau;
    property show_niveau:integer read Fniveau write affiche_un_niveau;
published
    property Lignes:Tstrings read Getlignes write Setlignes; {Lignes accessibles}
end;

implementation

function TTree3.Getlignes:Tstrings;
begin
result:=Arbre.lines
end;

procedure TTree3.Setlignes(x:Tstrings);
begin
Arbre.lines:=x
end;
RESTE DU CODE IDENTIQUE A LA CLASSE.

EXECUTION DU PROGRAMME (testez le clic droit sur un noeud) :