VPF::текстовый файл - Форум программистов

1111qq

Дата 18.3.2008, 22:06 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 5.11.2007

Репутация: нет
Всего: нет

Помогите пожайлуста переделать из типизированого файла в ТЕКСТОВЫЙ. Задание : сделать анкету которая содержит поля фамилия, имя, степень родства(кто он брат, сестра, отец, мать и т.д), год рождения, город проживания, професия. Вывести всю информацию о родствениках возраст которых меньше среднего возраста. Все процедуры поместить в модуль. В теле основной программы осуществить вызов процедур из модуля. вот эта задача в типизированом файле. Заранее всем большое спасибо.
МОДУЛЬ

Код


unit ss;
interface
type
    peop=record
         fam:string[15];
         nam:string[15];
         rod:string[10];
         city:string[15];
         year:1900..2007;
         prof:string[15];
    end;

t=file of peop;


 procedure create(var f1:t);
 procedure obr(var f1:t);
 procedure pech(var f1:t);
 
implementation

procedure create;
 var
   n,i:byte;
   s:peop;
begin
 reset(f1);
 write('vvedite kol-vo= ');
 readln(n);
 for i:=1 to n do
  begin
   write('familiy= ');readln(s.fam);
   write('name= ');readln(s.nam);
   write('rod= ');readln(s.rod);
   write('city= ');readln(s.city);
   write('year= ');readln(s.year);
   write('Profession= ');readln(s.prof);
   write(f1,s);
  end;
 close(f1);
end;


procedure pech;
 var
  i,n:byte;
  s:peop;
begin
 reset(f1);
 for i:=1 to filesize(f1) do
  begin
   read(f1,s);
   with  s do
   write(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof,'  ');
   writeln;
  end;
end;


procedure obr;
var
   i:byte;
   s:peop;
   srv:integer;
begin
   reset(f1);
   srv:=0;
   for i:=1 to filesize(f1) do
       begin
          read(f1,s);
          srv:=srv+(2008-s.year);
       end;
   close(f1);
   srv:=srv div i;
   reset(f1);
   writeln('srednij vozrast = ',srv);
   writeln('rodstvenniki, vozrast kotorih menshe srednego:');
   writeln;
   for i:=1 to filesize(f1) do
         begin
           read(f1,s);
           if (2008-s.year)< srv then
               begin
                 with s do
                      begin
                         writeln(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof);
                         writeln('-------------------------------------------------');
                      end;
               end;
         end;
     close(f1);
end;

end.

ОСНОВНАЯ ПРОГРАММА

Код


program kk;
 uses crt,SS;
var
 i:byte;
 f1:t;
begin
 clrscr;
    assign(f1,'data.dbf');

 {$I-}
 reset(f1);
 {$I+}
 if Ioresult<>0 then
   begin
   rewrite(f1);
create(f1);
   end;
 {create(f1);}
 
 pech(f1);
 obr(f1);
 readln;
end.

Albinos_x

Дата 18.3.2008, 23:36 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: нет
Всего: 108

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

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

1111qq

Дата 19.3.2008, 07:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 5.11.2007

Репутация: нет
Всего: нет

не получается переделать из типизированого файла в текстовой.

1111qq

Дата 19.3.2008, 17:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 5.11.2007

Репутация: нет
Всего: нет

помогите пожайлста переделать, я в текстовых файлах плохо понимаю

1111qq

Дата 19.3.2008, 18:17 (ссылка)

(голосов:1)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 5.11.2007

Репутация: нет
Всего: нет

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

Код


unit ss;
interface
type
    peop=record
         fam:string[15];
         nam:string[15];
         rod:string[10];
         city:string[15];
         year:1900..2007;
         prof:string[15];
    end;

t1=text;
t= file of peop;


procedure create(var f1:t);
procedure obr(var f1:t);
procedure pech(var f1:t);

implementation

procedure create;
var
   kol,i:byte;
   chel:peop;
begin
rewrite(f1);
write('vvedite kol-vo= ');
readln(kol);
for i:=1 to kol do
with chel do
  begin
   write('familiy= ');readln(s.fam); writeln(f1, fam);
   write('name= ');readln(s.nam); writeln(f1, nam);
   write('rod= ');readln(s.rod); writeln(f1, rod);
   write('city= ');readln(s.city); writeln(f1, city);
   write('year= ');readln(s.year); writeln(f1, year);
   write('Profession= ');readln(s.prof);
   
  end;
close(f1);
end;


procedure pech(var f:t1; var kol:byte);
var
  i,kol:byte;
  chel:peop;
begin
rewrite(f);
while not(f) do
  with chel do
      begin 
readln(f,fam); write(fam,' ');
readln(f,name); write(name,' ');
readln(f,rod); write(rod,' ');
readln(f,city); write(city,' ');
readln(f,year); write(year,' ');
readln(f,prof); write(prof,' ');
writeln;
{writeln(fam,' ',),}
end;
close(f);
end;


procedure obr;
var
   i:byte;
   s:peop;
   srv:integer;
begin
   reset(f1);
   srv:=0;
   for i:=1 to filesize(f1) do
       begin
          read(f1,s);
          srv:=srv+(2008-s.year);
       end;
   close(f1);
   srv:=srv div i;
   reset(f1);
   writeln('srednij vozrast = ',srv);
   writeln('rodstvenniki, vozrast kotorih menshe srednego:');
   writeln;
   for i:=1 to filesize(f1) do
         begin
           read(f1,s);
           if (2008-s.year)< srv then
               begin
                 with s do
                      begin
                         writeln(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof);
                         writeln('-------------------------------------------------');
                      end;
               end;
         end;
     close(f1);
end;

end.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »