VPF::[Pascal]типизированный файл+записи

Fuaran8989

Дата 14.4.2008, 13:31 (ссылка)

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

Загрузка ...

Новичок

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

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

Имеется типизированный файл, состоящий из записей следующей структуры: ФАМИЛИЯ, ГОД РОЖДЕНИЯ.
Создать новый файл и поместить в него записи о людях, возраст которых не попадает в указанный диапазон. Определить средний возраст людей, записи которых помещены во второй файл. Продублировать вывод на консоли.

Rodman

Дата 14.4.2008, 13:57 (ссылка)

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

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

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

Код


program Project2;

uses
  Crt;
type
  TMyRec = record
      FIO:string;
      year:Integer;
  end;
var f, f1: file of TMyRec;
    MyRec:TMyRec;
    i, j, sum, border:Integer;
function MainMenu():Integer;
var jj:Integer;
begin
  clrscr();
  Writeln('1. Make new file');
  Writeln('2. Copy data');
  Writeln('-----------------');
  Writeln('0. Exit');
  Read(jj);
  MainMenu:=jj;
end;

procedure CreateFile(fileName:string);
var i:Integer;
begin
  Assign(f, fileName);
  Rewrite(f);
  repeat
    Write('Enter FIO:');
    Read(MyRec.FIO);
    Write('Enter year:');
    Read(MyRec.year);
    Write(f, MyRec);
    Write('Need continue = 1, else = 0');
    Read(i);
  until i=0;
end;

procedure ShowData(fileName:string);
var count:Integer;
begin
  Assign(f, fileName);
  Seek(f, 0);
  while not eof(f) do
  begin
    Read(f, MyRec);
    Write(MyRec.FIO, ' ', MyRec.year);
    sum:=sum+(2008 - MyRec.year);
    inc(count);
  end;
  Write('Middle year = ', sum/count);
end;

procedure CopyData(fileName, fileName1:string);
var Low, high, count:Integer;
begin
  Assign(f, fileName);
  Seek(f, 0);
  Write('Enter low border');
  Read(Low);
  Write('Enter high border');
  Read(high);
  Assign(f1, fileName1);
  Rewrite(f1);
  sum:=0;
  count:=0;
  while not eof(f) do
  begin
    Read(f, MyRec);
    if ((MyRec.year<Low)or(MyRec.year>high)) then
      Write(f1, MyRec);
  end;
  ShowData(fileName1);
end;

begin
  repeat
    j:=MainMenu;
    if(j=1)then
      CreateFile('1.txt')
    else if(j=2)then
      CopyData('1.txt', '2.txt');
  until j=0;
end.

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

CRM с функцией АвтоОбзвона

Лотереи мира

Fuaran8989

Дата 14.4.2008, 14:39 (ссылка)

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

Загрузка ...

Новичок

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

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

Да...спасибо за такой труд=) мега навороченная прога...думаю что без Главного меню было бы намного лучше=)

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