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.