Liste de chaînes

Niveau classe à partir d'une unité existante
 (CD-ROMDelphi.ListeChaines\Liste1Class.Dlfi)

Objectif : Implantation sous forme d'une classe Delphi dans une unité (TAD de  liste de chaînes de caractères).

La fiche principale, le code associé dans la unit
 

Exécuter le programme
 

La fiche principale du  projet :

                                  interface de test de la classe
                                                                                                    Remonter 

Le code de la Unit fiche principale :

unit UClassList;

interface
Uses StdCtrls;
const
     max_elt = 100;
type
 T0 = string;
 liste =class
         public
          function Est_vide:boolean;
          function longueur : integer;
          procedure supprimer (rang: integer);
          procedure inserer (rang: integer; x: T0);
          function kieme (rang: integer): T0;
          procedure ajouter(x:T0);
          procedure effacer;
          function Test (x: T0): boolean;
          procedure Rechercher (x: T0; var place: integer);
          procedure init_liste;
          procedure creationListe(Box:TListBox);
         private
          suite: array[1..max_elt] of T0;
          long: 0..max_elt;
          init_ok:char;
          procedure Test_Recherche(x:T0;var trouve:boolean;var rang:integer);
        end;

implementation
{//////////////////////////////// INTERNE ///////////////////////////////}
Uses Dialogs;
procedure writeln(s:string);
begin
 showmessage(S)
end;
{//////////////////////////////// PRIVATE ///////////////////////////////}

procedure liste.Test_Recherche(x:T0;var trouve:boolean;var rang:integer);
 var
    fini,present:boolean;
    i,n:integer;
begin
 trouve:=false;
 if not self.Est_vide then
 begin
   fini := false;
   i := 1;
   n:=self.long;
   present := false;
   while not fini and not present do
    begin
      if i <= n then
        if self.suite[i] <> x then
          i := i + 1
        else
          present := true
      else
        fini := true
    end;
    if present then
    begin
       {valeur x trouvée a l'indice:i}
       trouve:=true;
       rang:=i
    end
    else
    begin
        {cette valeur x n'est pas dans le tableau}
        trouve:=false;
        {on n'affecte aucune valeur a rang !! }
    end
 end
end;

 {//////////////////////////////// PUBLIC /////////////////////////////}

procedure liste.init_liste;
{initialisation obligatoire}
begin
 with self do
 begin
   long:=0;
   init_ok:='#'
 end
end;

function liste.Est_vide:boolean;
begin
 if self.init_ok<>'#' then
 begin
    writeln('>>> Gestionnaire de Liste: Liste non initialisée !! (erreur fatale)');
    halt
 end
 else
     if self.long=0 then Est_vide:=true
     else  Est_vide:=false
end;

function liste.longueur : integer;
begin
     longueur := self.long
end;

procedure liste.supprimer (rang: integer);
var
   n: 0..max_elt;
   i: 1..max_elt;
begin
 if not self.Est_vide then
 begin
  n := self.longueur;
  if rang in [1..n] then {le rang est correct}
  begin
   if (n=1)or(rang=n) then  self.long :=n-1 {un seul élément ou le dernier}
   else
   begin {n>1 et rang < n}
     for i := rang to n - 1 do
  self.suite[i] := self.suite[i + 1];
     self.long := n - 1
   end
  end
 end
end;{supprimer}

procedure liste.inserer (rang: integer; x: T0);
{on insère à la place de l'élément  "rang" qui est
repoussé lui-même d'un rang à droite (il est à rang+1)}
var
   n: 0..max_elt;
   i: 1..max_elt;
begin
 n:=self.longueur;
 if not self.Est_vide then
 begin
  if n < max_elt then {il y a assez de place pour insérer}
   if rang in [1..n] then {le rang est correct}
   begin
     for i := n downto rang do
 self.suite[i + 1] := self.suite[i];
     self.suite[rang] := x;
    self.long := self.long + 1
   end
 end
 else
 if rang=1 then  {le numéro du rang est cohérent}
    ajouter(x) {lorsque la liste est vide on voulait rajouter en tête}
end;
 

function liste.kieme (rang: integer): T0;
begin
 if not self.Est_vide then
 begin
     kieme := self.suite[rang]
 end
end;

procedure liste.ajouter(x:T0);
var
   n: 0..max_elt;
begin
 n:=self.longueur;
 if n < max_elt then {il y a assez de place pour insérer}
 begin
  self.suite[n+1]:=x;
  self.long :=n+1
 end
end;

procedure liste.effacer;
begin
 self.long:=0;
end;

function liste.Test (x: T0): boolean;
  {teste la presence ou non de x dans la liste L}
 var
    present:boolean;
    rang:integer;
begin
 Test:=false;
 if not self.Est_vide then
 begin
   Test_Recherche(x,present,rang);
   Test:=present
 end
end;

procedure liste.Rechercher (x: T0; var place: integer);
 var
    present:boolean;
begin
 place:=0;
 if not self.Est_vide then
   Test_Recherche(x,present,place);
end;

procedure liste.creationListe(Box:TListBox);
{création de la liste L (le ListBox est déjà chargé manuellement}
var i:integer;
begin
 for i:=0 to Box.Items.count-1 do
  self.suite[i+1]:=Box.items[i];
 self.Long:=Box.Items.count ;
end;
 

end.
                                                                             Remonter