algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Lista - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 6
SłabyŚwietny
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.
Dodaj komentarz