program kolejkastos; {$APPTYPE CONSOLE} uses SysUtils; type stack = ^Tstack; Tstack = record data : integer; next : stack; end; T_Kolejka = record StosA : stack; StosB : stack; end; // ========================================================================== // // Dokladanie elementu na stos: procedure PushS(Value : integer; var Top : stack); var TempItem : stack; begin TempItem := Top; New(Top); Top.data := value; Top.next := TempItem; end; // ========================================================================== // // Usuwanie elementu ze stosu: function PopS(var Top : stack; var Val : integer) : boolean; var TempItem : stack; begin if Top <> nil then begin Val := Top.data; TempItem := Top; Top := Top.next; Dispose(TempItem); result := true; end else result := false; end; // ========================================================================== // // Kasowanie stosu: procedure DestroyS(var Top : stack); var TempItem : stack; begin while (Top <> nil) do begin TempItem := Top.next; Dispose(Top); Top := TempItem; end; end; // ========================================================================== // // Kopiowanie stosu TopS(Source) na stos TopD(Destination): procedure CopyS(TopS : stack; var TopD : stack); var TopR : stack; begin TopR := nil; while (TopS <> nil) do begin PushS(TopS.data, TopR); TopS := TopS.next; end; while(TopR <> nil) do begin PushS(TopR.data, TopD); TopR := TopR.next; end; DestroyS(TopR); end; // ========================================================================== // // Dokladanie elementu do kolejki: procedure Push(Value : integer; var K1 : T_Kolejka); begin PushS(Value, K1.StosA); end; // ========================================================================== // // Kasowanie elementu z kolejki: function Pop(var K1 : T_Kolejka; var Value : integer) : boolean; begin CopyS(K1.StosA, K1.StosB); if (PopS(K1.StosB, Value)) then begin result := true; DestroyS(K1.StosA); CopyS(K1.StosB, K1.StosA); end else result := false; DestroyS(K1.StosB); end; // ================================= TESTER ================================= // var Kolejka : T_Kolejka; Value : integer; i, j : integer; begin Randomize; WriteLN('=== Testowanie wrzucania 15 elementow do kolejki...'); for i:=1 to 1 do begin Value := Random(100); Push(Value, Kolejka); WriteLN('Na stos wrzucono liczbe ', Value); end; WriteLN('=== OK.'); WriteLN('=== Testowanie wrzucania 5 elementow z kolejki...'); for i:=1 to 5 do begin if Pop(Kolejka, Value) = true then WriteLN('Z kolejki zdjeto liczbe: ', Value) else WriteLN('Brak elementow do zdjecia z kolejki.'); end; WriteLN('=== OK.'); WriteLN('=== Testowanie zakonczono pomyslnie.'); ReadLN; end.