реализовать стек из записей, срочно нужно...помогите плиз Опции

[serega204]

посмотрите пожалуйста программу и помогите сделать задание....не получается у меня
вот задание: Реализовать стек, содержащий записи, состоящие из двух полей: названия города и года основания. Напечатать в порядке, обратном поступлению, сначала все древние города (древнее заданного года), а затем более молодые

Program LR1;    Uses Crt;
Type
PStruct = ^Struct;
Struct = Record
         GR  : String[12];
         NM  : 1600 .. 2000;
         Ptr : PStruct;
         inf : integer;
         End;
Const C : Array [1..7] of string[40] = (
  '                           ',
  '        Towns of Riga      ',
  'ХННННННННННННСННННННННННННё',
  'іName of TownіYear of Baseі',
  'ЖННННННННННННШННННННННННННµ',
  'ГДДДДДДДДДДДДЕДДДДДДДДДДДДґ',
  'ФННННННННННННПННННННННННННѕ' );
Var Stack  : PStruct;
   h, Year : integer;
    Fi, Fr : Text;
         m : byte;

Procedure Sh;
Begin
     For m := 1 to 5 do Writeln (Output, C[m]);
End;

Procedure P (Z1 : Struct);
Begin
Writeln (Output, 'і', Z1.GR :12   , 'і' :1 , Z1.NM  , ' і':9);
End;

Procedure Push (Var S : PStruct; e : integer);
Var z : PStruct;
Begin
     z^.ptr := S;
     z^.inf := e;
     S := z;
End;

Function Pop  (S : PStruct) : Integer;
Var z : PStruct;
Begin
     If S = Nil then
     Begin
     Writeln ('stek pust');
     end       else
     Begin
          z := S;
          S := S^.ptr;
          Pop := z^.inf;
    End;
end;

Procedure Vivod;
Var S : PStruct;
Begin S := Stack;
While S <> Nil do begin
        P(S^);
        S := S^.Ptr;
{If S <> Nil then Writeln (Output, C[6])
            else Writeln (Output, C[5]); }
                  End;
End;

Procedure Dop (Var S : PStruct; Dat : integer);
Var Nov : PStruct;
Begin New (Nov);
      Nov^.inf := Dat; Nov^.Ptr := Stack; Stack := Nov;
End;

Procedure Vvod;
Var Z : Struct;
Begin
     Assign (Fi, 'ishodnie.dat'); Reset (Fi);
Writeln (#10#13, 'Zapolnenie steka novimi zapisami', #10#13);
While not Seekeof (Fi) do
with Z do begin
Readln (Fi, GR, NM);
P(Z); Dop (Stack, h);
       End;
Close (Fi);
End;

Function Cht (S : PStruct) : Integer;
Begin
     If S <> nil Then Cht := S^.inf
End;

Procedure Ud (Var S : PStruct);
Var Old : PStruct;
Begin If S <> Nil then Begin
Old := S; S := S^.Ptr; {P(Old^);}
Dispose (Old);         end
End;

{----- -----}
Begin  CLRSCR;
Assign (Output, '');         Rewrite (Output);
Stack := Nil;
Writeln ('Proverka pustoti steka');
Sh;
Cht(Stack);
Ud(Stack);
Vvod;
Vivod;

Writeln (#10#13, 'Chtenie i udalenie zapisey iz steka', #10#13);
while Stack <> Nil do
      Begin Cht (Stack);
            Ud  (Stack);
      End;
Writeln (#10#13, 'Vvedite god osnovania goroda');
Read(Year);
Cht (Stack);
Ud  (Stack);
{Push (Stack,h);}
Close (Output);
readln;
end.

Сообщение отредактировано: Lapp - 24.10.2009 1:56

[Lapp]

не получается у меня

Что именно не молучается? В каком месте? Что, нам нужно самим об этом догадываться?..

[serega204]

у меня не получается вывести элементы записи согсасно заданию....помоему чего-то в процедуре вывода не хватает....только не знаю чего