{**********************************************************************
Copyright (C) 2009 by Salvatore Licciardi

Web http://www.webalice.it/turylicciardi    eMail turylicciardi@tiscali.it

 This program is free software: you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free Software
 Foundation, version 3 of the License.
 This program is distributed in the hope  that it will be useful , but WITHOUT
 ANY WARRANTY without even the implied warranty  of MERCHANTABILITY or FITNESS
 FOR A PARTICULAR PURPOSE.
 See the GNU General Public License for more details. You should have received
 a copy of the GNU General Public License along with this program. If not, see
 http://www.gnu.org/licenses/

 **********************************************************************}

unit Lista_S; // lista di stringhe.  Richiede FPC 1.9.x
{$MODE ObjFpc}
interface

type Lista_Esadecimale=object

     public
      constructor init;
      destructor  destroy;
      procedure   Stampa;
      procedure   Cancella_iniziale;
      procedure   Reverse;
      function    Input(s:string):boolean; // in coda, ma e' come se fosse iniziale
      function    Input(s:string; top:boolean):boolean; // in coda, ma e' come se fosse iniziale
      function    NumElementi():longint;
      function    Get_stringa(n:longint):string;   // parte da 1
      function    Get_stringa(n:longint; top:boolean):string;   // parte da 1
      function    Get_mem_usata:longint;
      function    Estrai_iniziale:string;  // con rimozione
      function    Inserisci(posizione:longint; testo:string):boolean;
      function    Set_Stringa(n:longint; s:string):boolean;
      function    Estrai_stringa(n:longint):string;
      function    Set_Length(n:longint):boolean; // le righe nuove, sono vuote

     private

     protected
      dati:array of string;
     end;

implementation

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function MemAvail:longint;  { a partire da FPC 1.9.6 }
begin
memAvail:=high(longint) div 2;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

constructor Lista_Esadecimale.init;
begin
setlength(dati,0);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

destructor Lista_Esadecimale.destroy;
begin
setlength(dati,0);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lista_Esadecimale.Set_Length(n:longint):boolean; // le righe nuove, sono vuote
var l:longint;
begin
Set_Length:=true;
if n<0 then Exit(false);
l:=length(dati);
setlength(dati,n);
if n<=l then Exit;
while l<=n do
      begin
      l:=l+1;
      Set_Stringa(l-1,'');  // :boolean
      end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lista_Esadecimale.Input(s:string):boolean; // in coda, ma e' come se fosse iniziale
begin
exit(Input(s,true));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lista_Esadecimale.Input(s:string; top:boolean):boolean; // in coda, ma e' come se fosse iniziale
var i:longint;
begin
if memavail>500 then Input:=true
                else Exit(false);
setlength(dati,length(dati)+1);
if top then dati[length(dati)-1]:=s
       else
        begin
        for i:=length(dati)-1 downto 1 do dati[i]:=dati[i-1];
        dati[0]:=s;
        end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure  Lista_Esadecimale.Cancella_iniziale; // cioe' in coda
begin
if length(dati)>0 then setlength(dati,length(dati)-1);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.Estrai_iniziale:string;
var s:String;
begin
s:=get_stringa(1);
Cancella_iniziale;
exit(s);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function Lista_Esadecimale.NumElementi():longint;
begin
exit(length(dati));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.get_stringa(n:longint):string;
begin
exit(get_stringa(n,false));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.get_stringa(n:longint; top:boolean):string;
begin
if (n<1)or(n>length(dati)) then exit('');
if top then exit(dati[n-1])
       else exit(dati[length(dati)-n]);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.estrai_stringa(n:longint):string;
var i:longint;
begin
if (n<1)or(n>length(dati)) then exit('');
result:=dati[length(dati)-n];
for i:=length(dati)-n to length(dati)-2 do dati[i]:=dati[i+1];
setlength(dati,length(dati)-1);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure  Lista_Esadecimale.Reverse;
var s:string;
    i:longint;
begin
for i:=1 to length(dati) div 2 do
    begin
    s:=dati[i-1];
    dati[i-1]:=dati[length(dati)-i];
    dati[length(dati)-i]:=s;
    end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure  Lista_Esadecimale.Stampa;
var j:longint;
begin
for j:=0 to length(dati)-1 do writeln(dati[j],' - ',length(dati[j]));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function   Lista_Esadecimale.Get_mem_usata:longint;
var j,mem:longint;
begin
mem:=0;
for j:=0 to length(dati)-1 do mem:=mem+length(dati[j]);
exit(mem);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.Inserisci(posizione:longint; testo:string):boolean;
var i:longint;
begin
if (memAvail<500)or(posizione<1)or(posizione>numelementi+1) then Exit(false);
setlength(dati,length(dati)+1);
for i:=length(dati)-1 downto posizione do dati[i]:=dati[i-1];
dati[posizione-1]:=testo;
Exit(true);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  Lista_Esadecimale.set_stringa(n:longint; s:string):boolean;
begin
if (n<1) then exit(false);
if n>length(dati) then exit(input(s)) // inserisce in coda elemento nuovo
                  else dati[length(dati)-n]:=s; // aggiorna
result:=true;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

end.

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

Versione:    Data:     Righe:  Modifica:

1.0.4      03/05/05     160    con Estrai_stringa;
1.0.3      18/12/04     130    con inserisci;
1.0.2      01/09/04     118    con Reverse;
1.0.1      21/08/04     105    con cancella_iniziale;
1.0.0      ? /08/04      ?     inizio.
