Liste de chaînes

Niveau classe visuelle générique
 (CD-ROMDelphi.ListeChaines\Liste5VisuGeneric.Dlfi)

Objectif : Implantation sous forme d'une classe Delphi générique (les données peuvent être soit des entiers, soit des chaînes, soit des réels, soit des booléens) héritant directement de la classe visuelle des "TListBox" de Delphi.

Attention cet exemple ne peut être complètement assimilé que lorsque le lecteur connaît le cours sur l'écriture des composants, dans le cas contraire l'exemple peut être pris tel quel en observant la réutilisation sans pousser plus avant la réflexion.

La fiche principale, le code associé dans la unit
 

Exécuter le programme

Le code du composant logiciel de liste visuelle générique.
 

La fiche principale du  projet :

                          interface de test de la classe visuelle générique
                                                                                                    Remonter  en haut.

Le code de la Unit fiche principale :

unit UFListe;
{utilise le composant liste de la palette perso les sources et
les ressources sont dans les UcompoListeVisugeneric.pas et .dcr
si ce composant UcompoListeVisugeneric.pas n'est pas présent dans
la palette des composants, ce programme ne fonctionnera pas.
Si c'est le cas installez UcompoListeVisugeneric dans la palette:
   UcompoListeVisugeneric.pas = le source du composant
   UcompoListeVisugeneric.dcr = les ressources bitmaps
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, UcompoListeVisugeneric;
type
  TForm1 = class(TForm)
    ButtonLong: TButton;
    ButtonInserer: TButton;
    ButtonSupprimer: TButton;
    ButtonKieme: TButton;
    EditInserer: TEdit;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    EditSupprimer: TEdit;
    EditKieme: TEdit;
    EditLongueur: TEdit;
    ButtonFin: TButton;
    ButtonEffacer: TButton;
    ButtonRecharger: TButton;
    LabelInfoEcran: TLabel;
    Bevel5: TBevel;
    LabelInfoOperateur: TLabel;
    LabelNbrElement: TLabel;
    LabelCompte: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    liste1: TlisteVisuGen;
    Label1: TLabel;
    Label2: TLabel;
    procedure ButtonInsererClick(Sender: TObject);
    procedure ButtonFinClick(Sender: TObject);
    procedure ButtonEffacerClick(Sender: TObject);
    procedure ButtonRechargerClick(Sender: TObject);
    procedure ButtonLongClick(Sender: TObject);
    procedure ButtonSupprimerClick(Sender: TObject);
    procedure ButtonKiemeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  liste1:TlisteVisuGen;

implementation

{$R *.DFM}
{-------------------  procédures de service --------------------}
procedure VoirLongueur;
begin
 Form1.LabelCompte.caption:=InttoStr(form1.liste1.longueur)
end;

procedure TForm1.ButtonFinClick(Sender: TObject);
begin
  close
end;
{----------------  Fin des procédures de service -----------------}
{----------------  procédures de visualisation -------------------}
procedure TForm1.ButtonRechargerClick(Sender: TObject);
begin
 Liste1.Items.LoadFromFile('Liste.ini');
 ButtonRecharger.enabled:=false;
end;

procedure TForm1.ButtonEffacerClick(Sender: TObject);
begin
 Liste1.effacer;
 ButtonEffacer.enabled:=false;
 ButtonRecharger.enabled:=true;
end;
{--------------  Fin des procédures de visualisation -------------}
{----------------  procédures opérateurs de liste ----------------}
procedure TForm1.ButtonInsererClick(Sender: TObject);
begin
 if length(EditInserer.text)<>0 then
  if Liste1.ItemIndex<>-1 then
  begin
   Edit1.text:=inttostr(integer(liste1.Typeobjet));
   Edit2.text:=inttostr(vartype(EditInserer.text));
   ButtonEffacer.enabled:=true;
   Liste1.inserer(Liste1.ItemIndex+1,EditInserer.text);
   EditInserer.text:='';
  end;
  VoirLongueur;
 end;

procedure TForm1.ButtonSupprimerClick(Sender: TObject);
begin
  if Liste1.ItemIndex<>-1 then
  begin
   ButtonEffacer.enabled:=true;
   EditSupprimer.text:='suppression de: '+Liste1.Items[Liste1.ItemIndex];
   Liste1.supprimer (Liste1.ItemIndex+1);
  end;
  VoirLongueur;
end;

procedure TForm1.ButtonKiemeClick(Sender: TObject);
var Rang, Code:integer;
begin
 if length(EditKieme.text)<>0 then
  begin
   Val(EditKieme.Text, Rang, Code);
   if Code=0 then
    if Rang in [1..Liste1.longueur] then
    begin
     EditKieme.text:='N° '+InttoStr(Rang)+' : '+Liste1.kieme (Rang);
     Liste1.ItemIndex:=Rang-1
    end
  end;
  VoirLongueur;
end;

procedure TForm1.ButtonLongClick(Sender: TObject);
begin
 EditLongueur.text:=InttoStr(liste1.longueur)
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Liste1.Items.LoadFromFile('Liste.ini');
 VoirLongueur;
end;

end.
                                                                             Remonter  en haut

Le code de la Unit fiche principale :
unit UcompoListeVisugeneric;

interface
Uses Classes,StdCtrls;
type
 LesObjets=(entier,reel,chaine,booleen,objet);
 T0 = variant;
 TlisteVisuGen =class(TListBox)
         public
          constructor create(Aowner:Tcomponent);override;
          function longueur : integer;
          procedure supprimer (k: integer);
          procedure inserer (k: integer; x: T0);
          function kieme (n: integer): T0;
          function Test (x: T0): boolean;
          procedure Rechercher (x: T0; var place: integer);
          procedure Ajouter(x:T0);
          procedure effacer;
         private
          FTypeObjet:integer;
          function Est_vide:boolean;
          procedure SetTypeObjet(x:LesObjets);
          function GetTypeObjet:LesObjets;
         published
          property TypeObjet:LesObjets read GetTypeObjet write SetTypeObjet;
        end;
 procedure register;

implementation
{//////////////////////////////// INTERNE ///////////////////////////////}
Uses Dialogs;
procedure register;
begin
 RegisterComponents('Perso',[TlisteVisuGen])
end;

procedure writeln(s:string);
begin
 showmessage(S)
end;
{//////////////////////////////// PRIVATE ///////////////////////////////}
function TlisteVisuGen.Est_vide:boolean;
begin
 if not assigned(self) then
 begin
    writeln('>>> Gestionnaire de Liste: Liste non initialisée !! (erreur fatale)');
    halt
 end
 else
     if self.items.count=0 then
          Est_vide:=true
     else Est_vide:=false
end;

procedure TlisteVisuGen.SetTypeObjet(x:LesObjets);
begin
 case x of
  entier  :FTypeObjet:=varInteger;
  reel    :FTypeObjet:=varCurrency;
  booleen :FTypeObjet:=varBoolean;
  chaine  :FTypeObjet:=varString;
  objet   :FTypeObjet:=varvariant;
 end
end;

function TlisteVisuGen.GetTypeObjet:LesObjets;
begin
 case FTypeObjet of
    varInteger   :result:=entier;
    varCurrency  :result:=reel;
    varBoolean   :result:=booleen;
    varString    :result:=chaine;
    varvariant   :result:=objet;
 end
end;

{//////////////////////////////// PUBLIC /////////////////////////////}
constructor TlisteVisuGen.create(Aowner:Tcomponent);
begin
 inherited create(Aowner);
 TypeObjet:=objet;
 setbounds(50,50,100,150);
end;

function TlisteVisuGen.longueur : integer;
begin
     longueur := self.items.count
end;

procedure TlisteVisuGen.supprimer (k: integer);
begin
  self.items.Delete(k-1);
end;

procedure TlisteVisuGen.inserer (k: integer; x: T0);
begin
 if vartype(x)=FTypeObjet then
  self.items.Insert(k-1,x);
end;

function TlisteVisuGen.kieme (n: integer): T0;
begin
  kieme:=self.items.strings[n-1]
end;

function TlisteVisuGen.Test (x: T0): boolean;
{teste la présence ou non de x dans la liste L}
begin
 if not self.Est_vide then
  if self.items.IndexOf(x)=-1 then Test:=false
  else Test:=true
end;

procedure TlisteVisuGen.Rechercher (x: T0; var place: integer);
begin
 if not self.Est_vide then
  if self.items.IndexOf(x)=-1 then place:=0
  else place:=self.items.IndexOf(x)+1
end;

procedure TlisteVisuGen.Ajouter(x:T0);
begin
 if vartype(x)=FTypeObjet then
  self.items.Add(x);
end;

procedure TlisteVisuGen.effacer;
begin
  self.items.clear
end;
end.
                                                                                   Remonter en haut