Разработка программы «Киноафиши» на языке Turbo Pascal 7.1, страница 4

   writeln;

    temp:=top;

    while temp<>nil do

    begin

           write(tabl,'  ',temp^.x.nom:2);

     write(tabl,temp^.x.film:7);

     write(tabl,temp^.x.ori:6);

     write(tabl,'  ',temp^.x.year:4);

     write(tabl,temp^.x.gen:5);

     write(tabl,'   ',temp^.x.prod:8);

     write(tabl,'      ',temp^.x.dur:3);

     write(tabl,' ',temp^.x.lim:3);

     write(tabl,temp^.x.sit:10);

     write(tabl,'    ',temp^.x.act:8);

     writeln(tabl,' ',temp^.x.rat:3:2);

       temp:=temp^.y;

    end;

     close(tabl);

    window(1,10,20,15);

    writeln('Table was save. ');

    end;

  readkey;

end;

procedure save_(top:p);

var temp:p; buf:za; k,otv:integer;

begin

  k:=0;

  IF top=nil then begin window(1,10,20,15);writeln('   Table is empty!');end

          else

  begin

    window(1,10,35,15);

    writeln('  Would you like to save table?');

      write('  1-Yes/0-No   - '); readln(otv);

    If otv=1 then

     begin

       rewrite (Spisok);

       temp:=top;

       while temp<>nil do

       begin

      buf:=temp^;

      write(Spisok, buf);

      temp:=temp^.y;

       end;

       close(Spisok);

       writeln('  Table was save');

     end;

  end;

readkey;

end;

procedure chtenie(var top:p{; var spisok:fz});

var temp:p; buf:za;

    procedure add_(var t:p);

    begin new(t); t^.x:=buf.x; t^.y:=nil; end;

begin

reset(Spisok);

  top:=nil;

  while not EOF(Spisok) do

  begin

    read(Spisok,buf);

    IF top=nil then add_(top)

            else begin

                 temp:=top;

                 while temp^.y<>nil do temp:=temp^.y;

                 add_(temp^.y);

               end;

  end;

  close(Spisok);

window(1,10,20,15);

writeln(' Table was loaded.');

readkey;

end;

procedure find_( var top:p; var n:integer; poz_f,tip:integer);

var temp:p; key_nom,k:longint; fl:boolean; key_film,key_ori,key_gen:string[10];

begin

  fl:=false; k:=0;

  if top=nil then begin window(1,10,20,15);writeln('  Empty!!!');end

          else begin

               window(1,13,80,25);

               write(' Write key - ');

               IF tip=1 then readln(key_nom);

               IF tip=2 then readln(key_film);

               If tip=3 then readln(key_ori);

               If tip=4 then readln(key_gen);

              temp:=top; window(1,13,80,25); show_tabl_up;

              while temp<>nil do

               begin

                 case poz_0 of

                 1: If temp^.x.nom=key_nom then

                 begin show_elem(temp); k:=k+1; fl:=true; end;

                 2: If temp^.x.film=key_film then

                 begin show_elem(temp); k:=k+1; fl:=true; end;

                 3:  If temp^.x.ori=key_ori then

                 begin show_elem(temp); k:=k+1; fl:=true; end;

                 4:  If temp^.x.gen=key_gen then

                 begin show_elem(temp); k:=k+1; fl:=true; end;

                 end;

                 If k=5 then begin

                         show_tabl_down;

                         write(' push   <Space> - look futher'); readln;

                         clrscr; wherex; k:=0; show_tabl_up;

                       end;

                 temp:=temp^.y;

               end;

               show_tabl_down;

               IF fl=false then

                  begin

                 writeln; writeln('  Nothing was found!');

                  end;

              end;

readkey;clrscr;

end;

procedure change(var top:p; var n:integer);

var temp:p; n1,i,otv:integer; b,c:zap; kal,n2,n11,n4,n5,n8,n9:string;

    n10:real;n3,n6:word;n7:byte;

begin

 If n=0 then begin window(1,10,30,15);writeln('  First find the element.'); readkey; end

     else

 begin

   window(1,23,80,30);

   temp:=top;

   for i:=1 to n-1 do temp:=temp^.y;

   show_tabl_up; show_elem(temp); show_tabl_down;window(1,25,25,15);

   write('  Change? (1-Yes/0-No) - '); readln(otv); end;

   If otv=1 then

         begin

          temp:=top;

          for i:=1 to n-1 do temp:=temp^.y;