Реализация стека, (нужна помощь) Опции

[serega204]

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

Program LR1;    Uses Crt;
Type
St = Array [1..7] of string[40];
ST1 = String[12];
PStruct = ^Struct;
Struct = Record
         GR  : ST1;
         NM  : 1600 .. 2000;
         Ptr : PStruct;
         End;
Const C : St = (
  '                                  ',
  '        Towns of Riga      ',
  '                                  ',
  ' Name of Town Year of Base ',
  '                                  ',
  '                                  ',
  '                                 ' );
Var Stack  : PStruct;
    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 Vivod;
Var S : PStruct;
Begin S := Stack;     Sh;
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 (Dat : Struct);
Var Nov : PStruct;
Begin New (Nov);
      Nov^ := Dat; Nov^.Ptr := Stack; Stack := Nov;
End;

Procedure Vvod;
Var Z : Struct;
   { B : Char;  }
   Min : Integer;
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 (Z);
        End;
Close (Fi);
End;

Procedure Ud (Var S : PStruct);
Var Old : PStruct;
Begin If Stack <> Nil then Begin
Old := S; S := S^.Ptr; P(Old^); Dispose (Old);
                                end
                      else
Writeln(#10#13, 'Udalenie neuspeshno: stek pust');
End;

Procedure Cht (S : PStruct);
Begin
     If S <> nil Then P(S^)
                 Else Writeln (#10#13, 'Stek pust');
End;

Begin  CLRSCR;
Assign (Output, 'Rez.dat');         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, 'Proverka pustoti steka');
Cht (Stack);
Ud  (Stack);
Close (Output);
readln;
end.

М

1. Теги CODE не забывай... 2. Тему переименовал, а то "Нужна помощь" с главной страницы смотрится не очень...

Сообщение отредактировано: volvo - 16.10.2009 21:28