Liste de chaînes

Niveau Unité
 (CD-ROMDelphi.ListeChaines\Liste0.Dlfi)

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

La fiche principale, le code associé dans la unit

exécuter un exemple d'utilisation.
 
 

La fiche principale du  projet :

                                        interface de test de la unit
                                                                                                Remonter 

Le code de la Unit fiche principale :

Unit UListchn;

interface
const
     max_elt = 100;
type
    T0 = string;
    liste = record
                  suite: array[1..max_elt] of T0;
                  long: 0..max_elt;
                  init_ok:char;
              end;

function est_vide(L:liste):boolean;
function longueur (L: liste): integer;
procedure supprimer (var L: liste; rang: integer);
procedure inserer (var L: liste; rang: integer; x: T0);
function kieme (L: liste; rang: integer): T0;
procedure ajouter(var L:liste;x:T0);
procedure effacer(var L:liste);
function test (L: liste; x: T0): boolean;
procedure rechercher (L: liste; x: T0; var place: integer);
procedure init_liste(var L:liste);

 implementation
{------------------------------------}
Uses Dialogs;
procedure writeln(s:string); // simulation du writeln du pascal
begin
 showmessage(S)
end;
{------------------------------------}
procedure init_liste(var L:liste);
{initialisation obligatoire}
begin
 with L do
 begin
   long:=0;
   init_ok:='#'
 end
end;

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

 function longueur (L: liste): integer;
begin
     longueur := L.long
end;

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

 procedure effacer(var L:liste);
begin
 L.long:=0;
end;

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

procedure inserer (var L: liste; 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 := longueur(L);
 if not Est_vide(L) 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
 L.suite[i + 1] := L.suite[i];
     L.suite[rang] := x;
    L.long := L.long + 1
   end
 end
 else
 if rang=1 then  {le numéro du rang est cohérent}
    ajouter(L,x) {lorsque la liste est vide on voulait rajouter en tête}
end;

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

 procedure Test_Recherche(L:liste;x:T0;var trouve:boolean;var rang:integer);
 var
    fini,present:boolean;
    i,n:integer;
begin
 trouve:=false;
 if not Est_vide(L) then
 begin
   fini := false;
   i := 1;
   n:=longueur(L);
   present := false;
   while not fini and not present do
    begin
      if i <= n then
        if L.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}
      rang:=0
      {on affecte  à rang une valeur inexistante!! }
    end
 end
end;

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

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

end.
                                                                       Remonter