Показать сообщение отдельно

  #8  
Старый 02.01.2009, 12:56
Romantic1989
Новичок
Регистрация: 19.08.2008
Сообщений: 12
С нами: 9330602

Репутация: 5
По умолчанию

Вот тебе пример:
задание:
Дана информация по работниках бригады. Фамилия, год рождения, стать и профессия. Вывести фамилии женщин с заданной профессией.
Код:
Program pr10;
uses CRT;
type
    br=record
             fio:string[15];
             god:integer;
             pol:char;
             prof:string[25];
    end;
mas=array[1..100] of br;
var
   pm,n:byte;
   a:mas;
   f:file of br;
   ch:char;
   imfile:string[15];
   g:br;
Procedure enter(var g:br);
   begin
        writeln(‘Введите фамилию работник:');
        readln(g.fio);
        writeln(Введите год рождения работника: ');
        readln(g.god);
        writeln(Введите стать работника (М\Ж)');
        readln(g.pol);
        g.pol :=upcase(g.pol);
        writeln(' Введите профессию работника ');
        readln(g.prof);
   end;

Procedure recf;
   var ch:char;
       i:byte;
begin
   rewrite(f);
   repeat
         clrscr;
         enter(g);
         write(f,g);
   writeln('Еще?(Y/N)');
   readln(ch);
   until upcase(ch)='N';
   close(f);
end;
Procedure readf(var n:byte; var a:mas);
   var i:byte;
   begin
   i:=0;
   reset(f);
   while not eof(f) Do
         begin
              i:=i+1;
              read(f,a[i]);
         end;
         n:=i;
         close(f);
   end;

Procedure vief;
   var i:byte;
begin
     clrscr;
     writeln(' -- --------------- ---------------- ------- ------------------ ');
     writeln('|№ |  Ф.И.О     | Год рождения   | Стать |     Профессия     |');
     writeln(' -- --------------- ---------------- ------- ------------------ ');
     readf(n,a);
     for i:=1 to n do
         begin
              writeln('|',i:2,'|',a[i].fio:15,'|',a[i].god:16,'|',a[i].pol:7,'|',a[i].prof:18,'|');
         end;
     writeln(' -- --------------- ---------------- ------- ------------------ ');
end;
Procedure add;
var ch:char;
begin
     reset(f);
     seek(f,filesize(f));
     repeat
     clrscr;
     enter(g);
     write(f,g);
     writeln('Ще?(Y/N)');
     readln(ch);
     until upcase(ch)='N';
     close(f);
end;
Procedure edit;
var ch:char;
    ner:byte;
begin
     clrscr;
     vief;
     reset(f);
     repeat
     writeln('Введите номер записи который надо отредактироваь:');
     readln(ner);
     seek(f,ner);
     enter(g);
     write(f,g);
     writeln('Еще?(Y/N)');
     readln(ch);
     until upcase(ch)='N';
     close(f);
end;
Procedure filt;
var proff:string[25];
    i:byte;
begin
     writeln('Введите профессию:');
     readln(proff);
     writeln(' --------------- ---------------- ------- ------------------ ');
     writeln('|№ |  Ф.И.О     | Год рождения   | Стать |     Профессия     |');
     writeln(' --------------- ---------------- ------- ------------------ ');
     readf(n,a);
     for i:=1 to n Do
     begin
     if (a[i].pol='Ж') and (a[i].prof=proff) then writeln('|',a[i].fio:15,'|',a[i].god:16,'|',a[i].pol:7,'|',a[i].prof:18,'|');
     end;
     writeln(' ----------------------------------------------------------- ');
end;
Procedure del;
var ndr:byte;
    ch:char;
    i:byte;
begin
     repeat
     vief;
     writeln('Введите номер записи который надо удалить:');
     readln(ndr);
     a[ndr].fio:='DELETED';
      rewrite(f);
     for i:=1 to n Do
         if a[i].fio <> 'DELETED' then write(f,a[i]);
     writeln('Еще?(Y/N)');
     readln(ch);
     until upcase(ch)='N';

     close(f);
end;
begin
repeat
writeln('Введите имя файла для работы:');
readln(imfile);
assign(f,imfile);
clrscr;
Writeln('Меню:');
writeln('1.Запись в файл');
writeln('2.Просмотр');
writeln('3.Добавить запись');
writeln('4.Редактировать');
writeln('5.Фильтр');
writeln('6.Удаление записей');
writeln('Выход');
writeln('Выберите:');
read(pm);
         case pm of
              1:recf;
              2:vief;
              3:add;
              4:edit;
              5:filt;
              6:del;
              7:Exit;
         end;
         until pm>6;
end.
 
Ответить с цитированием