Nadesłany przez Michał Knasiecki, 16 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
lista_d/Unit1.pas:
//Program pobrany ze strony www.algorytm.org
//Opracowal: Michal Knasiecki
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
Edit2: TEdit;
Label2: TLabel;
Button2: TButton;
Label3: TLabel;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
Type wskaznik=^Lista;
Lista = record
dane:integer;
wsk:wskaznik;
end;
var
Form1: TForm1;
first,current:wskaznik;
tekst:integer;
i,k:integer;
implementation
{$R *.DFM}
procedure AddToList(dane:integer;var current:wskaznik);//Dodawanie liczby do listy
var prev,next:wskaznik; //w miejscy wyznaczonym przez wskaznik CURRENT
begin
if current<>nil then
begin
prev:=current;
next:=current^.wsk;
end else
begin
prev:=nil;
next:=nil;
end;
new(current);
current^.dane:=dane;
current^.wsk:=next;
if prev<>nil then prev^.wsk:=current;
end;
procedure GetAddr(dane:integer;var first,current:wskaznik);//Wyznaczanie adresu
var next:wskaznik; //elementu DANE i ustawianie w nim zmiennej CURRENT
begin
if first<>nil then
begin
next:=first;
repeat
if next^.wsk<>nil then next:=next^.wsk
until (next^.wsk=nil)or(next.dane=dane);
current:=next;
end;
end;
procedure GetNum(n:integer;var first,current:wskaznik);//Wyznaczanie adresu n-tego
var next:wskaznik; //elementu listy i ustawianie w nim zmiennej CURRENT
begin
if first<>nil then
if n=1 then current:=first else
if (n=2)and(first^.wsk=nil) then n:=0 else
begin
next:=first;
i:=1;
repeat
inc(i);
if next^.wsk<>nil then next:=next^.wsk
until (i=n)or(next^.wsk=nil);
if (next^.wsk=nil)and(i<n) then n:=0 else
current:=next;
end;
end;
procedure List; //wypisywanie listy
var l:integer;
begin
form1.listbox1.clear;
for l:=1 to i do begin
Getnum(l,first,current);
if l>1 then
form1.listbox1.items.add(inttostr(current^.dane));
end;
end;
procedure RemoveFromList(dane:integer;var first,current:wskaznik);//usuwanie elementu
var prev,next:wskaznik; //CURRENT
begin
if (first<>nil)and(current<>nil) then
if first<>current then
begin
prev:=first;
next:=prev^.wsk;
if next<>current then
repeat
prev:=next;
next:=prev^.wsk;
until next=current;
current^.dane:=dane;
prev^.wsk:=current^.wsk;
dispose(current);
current:=prev;
end else
begin
first^.dane:=dane;
first:=first^.wsk;
dispose(current);
current:=first;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
current:=nil;
addtolist(0,current);//Najmniejszym elementem listy może by 0
i:=1;
first:=current;
end;
procedure findLess(dane:integer;var first,current:wskaznik);//Wyznacza odpowiednie miejsce
var tmp,next:wskaznik; //dla elementu DANE i ustawia w nim CURRENT
begin
if first<>nil then
begin
next:=first;
repeat
if (next^.wsk<>nil) then begin
tmp:=next;
next:=next^.wsk
end;
until (next^.wsk=nil)or(next.dane>dane);
if next.dane>dane then current:=tmp else current:=next;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
inc(i);
findLess(strtoint(edit1.text),first,current); //znajdź miejsce dla zmienneh z edit1
addtolist(strtoint(edit1.text),current); //dodaj ją do listy
label3.caption:='Elementów: '+inttostr(i-1);
edit1.SetFocus;
list;
end;
procedure TForm1.Button2Click(Sender: TObject);
var l:integer;
begin
if i>0 then
begin
GetAddr(strtoint(edit2.text),first,current);//znajdź adres danej z edit2
label3.caption:='Elementów: '+inttostr(i-1);
removeFromList(tekst,first,current);// usuń ją z listy
dec(i);
label3.caption:='Elementów: '+inttostr(i-1);
listbox1.clear;
for l:=1 to i do begin//wypisz to, co zostalo
GetNum(l,first,current);
if l>1 then
listbox1.items.add(inttostr(current^.dane));
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var k:integer;
begin
for k:=1 to i do //usuń z pamięci calą listę
begin
Getnum(k,first,current);
RemoveFromList(tekst,first,current);
end;
end;
end.

