Pobierz Procedury - Notatki - Programowanie i więcej Notatki w PDF z Informatyka tylko na Docsity! Zbudujemy klasę List jak niżej: type TElement=string[10]; PCell=^TCell; TCell=record element : TElement; next : PCell; end; TPosition = PCell; List = class(TObject) private Head : PCell; NumItems : integer; public Text: string; procedure Show; procedure Init; procedure MakeNull; procedure Insert(x : TElement; p : TPosition); procedure Delete(p : TPosition); function Locate(x : TElement) : TPosition; function Retrieve(p : TPosition) : TElement; procedure Add(x : TElement; index :integer); procedure Remove(index : integer); function Count: integer; function Item(index : integer) : TElement; function Find(x : TElement): integer; end; Procedura Show zapisuje zawartość listy w zmiennej Text. Zmienna ta potem jest przepisywana do pola Memo. procedure List.Show; const CR = #13#10; var temp : PCell; begin Text:='Head ->'+CR; temp:=Head; while temp<> NIL do begin Text:=Text+temp^.element+' ->'+CR; temp:=temp^.next; end; Text:=Text+'NIL'; end; Procedura Init inicjuje listę. procedure List.Init; begin Head:=nil; NumItems:=0; Show; end; Procedura MakeNull zeruje zawartość listy usuwając po kolei wszystkie elementy. procedure List.MakeNull; var temp: PCell; begin while Head<>nil do begin temp:=Head; Head:=temp^.next; Dispose(temp); end; NumItems:=0; Show; end; Procedura Insert wstawia element x za elementem wskazywanym przez p. procedure List.Insert(x : TElement; p : TPosition); var temp : PCell; begin New(temp); temp^.element:=x; temp^.next:=p^.next; p^.next:=temp; Show; end; Procedura Delete usuwa element za elementem wskazywanym przez p. procedure List.Delete(p: TPosition); var temp : PCell; begin if p^.next<>nil then begin temp:=p^.next; p^.next:=temp^.next; Dispose(temp); end; Dec(NumItems); Show; end; Funkcja Locate zwraca wskaźnik do elementy x. function List.Locate(x : TElement) : TPosition; var temp : PCell; begin temp:=Head; while (temp<>nil) and (temp^.element<>x) do temp:=temp^.next; if temp=nil then Locate:=nil else Locate:=temp; end; Funkcja Retrieve zwraca element, na który wskazuje wskaźnik p. function List.Retrieve(p : TPosition) : TElement; begin Retrieve:=p^.element; end; Procedura Add wstawia element x na miejsce o indeksie index. procedure List.Add(x : TElement; index : integer); var temp, temp1 : PCell; begin if index=1 then begin // wstawianie na poczatek New(temp); temp^.element:=x; temp^.next:=Head; Head:=temp; procedure bInsertClick(Sender: TObject); procedure bItemClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; L : List; Procedury: procedure TForm1.FormCreate(Sender: TObject); begin L := List.Create; L.Init; PrintList; end; procedure TForm1.PrintList; begin Memo1.Lines.Clear; Memo1.Lines.Add(L.Text); end; procedure TForm1.bInitClick(Sender: TObject); begin L.Init; PrintList; end; procedure TForm1.bMakeNullClick(Sender: TObject); begin L.makenull; PrintList; end; procedure TForm1.bMakeClick(Sender: TObject); var i, n : integer; begin L.Makenull; n:=StrToInt(InputBox('Losowanie','Ile elementow?','')); for i:=1 to n do L.Add(IntToStr(Random(100)),1); PrintList; end; procedure TForm1.bAddClick(Sender: TObject); var s : TElement; ind : integer; begin s:=InputBox('Add','Podaj element',''); ind:=StrToInt(InputBox('Add','Podaj numer miejsca','')); if (ind > L.Count+1) or (ind < 1) then ShowMessage('Blad ') else L.Add(s,ind); PrintList; end; procedure TForm1.bRemoveClick(Sender: TObject); var ind : integer; begin ind:=StrToInt(InputBox('Remove','Podaj numer miejsca','')); if (ind > L.Count) or (ind < 1) then ShowMessage('Blad ') else L.Remove(ind); PrintList; end; procedure TForm1.bFindClick(Sender: TObject); var s : TElement; ind : integer; begin s:=InputBox('Add','Podaj element',''); ind:=L.Find(s); if ind<>-1 then ShowMessage('Element '+s+' znajduje sie na pozycji '+IntToStr(ind)) else ShowMessage('Elementu '+s+' nie ma na liscie'); end; procedure TForm1.bInsertClick(Sender: TObject); var s, t : string; p : PCell; begin s:=InputBox('Insert','Za jaki element wstawic?',''); p:=L.locate(s); if p<>nil then begin t:=InputBox('Insert','Podaj element?',''); L.insert(t,p); end else ShowMessage('Blad. nie ma takiego elementu'); PrintList; end; procedure TForm1.bItemClick(Sender: TObject); var t, s : string; i : integer; begin i:=StrToInt(InputBox('Item','Podaj numer pozycji','')); if (i>=1) and (i<=L.Count) then begin s:=L.Item(i); ShowMessage('Na pozycji '+IntToStr(i)+' znajduje sie element '+s); end else ShowMessage('Blad. Zla pozycja.'); end; Stos: CONST max=20; type PCell = ^Tcell; TCell = record element : integer; next : PCell; end; var Form1: TForm1; top : PCell; NumItems : integer; function Empty: boolean; begin if top=nil then Empty:=True else Empty:=False; end; function Full: boolean; begin if NumItems=MAX then Full:=True else Full:=False; end; procedure Init; begin top:=nil; NumItems:=0; end; procedure Push (x:integer); var temp : PCell; begin if not Full then begin new(temp); temp^.element:=x; temp^.next:=top; top:=temp; inc (NumItems); end; end; procedure Pop; var temp : PCell; begin if not Empty then begin temp:=top; top:=temp^.next; dispose (temp); dec (NumItems); end; end; procedure MakeNull; begin while not Empty do Pop; end; function First : integer; begin if not Empty then First:=top^.element; end; procedure StackShow; var temp: PCell; begin Form1.Memo1.Lines.Clear; if not Empty then begin temp:=top; while temp <> nil do begin Form1.Memo1.Lines.Add (IntToStr(temp^.element)); temp:=temp^.next; end; end; end; procedure StackDraw; var maxx, maxy, y : integer; temp : PCell; begin maxx:=Form1.PaintBox1.Width; maxy:=Form1.PaintBox1.Height; Form1.PaintBox1.Canvas.Brush.Color:=Form1.Color; Form1.PaintBox1.Canvas.FillRect(Rect(0,0,maxx,maxy)); if not Empty then begin temp:=top;