Справочник нумизмата

program Zadanie188project1;
 
uses
  crt;
const
  fname = 'monety.dat';//чтобы имя файла не писать в каждой процедуре
                          //объявим его константой
type TMonety = record
          namemonety: string[20];  // Наименование монеты
          state: string[20];       // Государство, которое печатало
          place: string[20];       // Место где найдена
          condition: string[20];   // Состояние
          end;
     TfileM = file of TMonety;
 
var b: boolean;
 
 
 
procedure InfInRec(var g: TMonety);
var
  j: Byte;
begin
  write('Наименование монеты: ');
  readln(g.namemonety);
  write('Государство, которое ее печатало: ');
  readln(g.state);
  write('Место где найдена: ');
  readln(g.place);
  write('Состояние монеты: ');
  writeln('Выберете степень состояния монеты выбрав цифру: ');
  writeln('1 - очень плохое');
  writeln('2 - плохое');
  writeln('3 - удовлетворительное');
  writeln('4 - хорошее');
  writeln('5 - отличное');
  readln(j);
  Case j of
  1: g.condition:= 'очень плохое';
  2: g.condition:= 'плохое';
  3: g.condition:= 'удовлетворительное';
  4: g.condition:= 'хорошее';
  5: g.condition:= 'отличное';
  end;
end;
 
 
procedure OutInfo(g: TMonety);
begin
  gotoXY(1,whereY);
  write('| ',g.namemonety:16);
  gotoXY(19,whereY);
  write('|',g.state:17);
  gotoXY(37,whereY);
  write('|',g.place:17);
  gotoXY(55,whereY);
  write('|',g.condition:17);
  gotoXY(73,whereY);
  writeln('|');
end;
 
procedure CreateFile(var f: TfileM);
var
  Mon: TMonety;
  ch: char;
begin
{Создание нового файла}
  clrscr;
  rewrite(f);
  writeln('Введите сведения об монетах в файл:');
  repeat
    InfInRec(Mon);
    write(f,Mon);  {запись в файл}
    repeat
      writeln('Добавить записи еще? y/Y - да n/N - нет');
      readln(ch);
    until upcase(ch) in ['Y','N'];
  until upcase(ch)='N';
  close(f);
end;
 
 
{шапка таблиц}
procedure Tabl;
begin
writeln('-------------------------------------------------------------------------');
writeln('|    Название     |   Государство   |  Место находки  |    Состояние    |');
writeln('-------------------------------------------------------------------------');
end;
 
 
{открытие файла}
procedure ResetFile(var f: TfileM; var b: boolean);
begin
  b:= true;
  {$I-} reset(f); {$I+}
  if IOResult <> 0 then
    begin
      b:= false;
      writeln('Файл еще не создан, вернитесь к пункту 1');
      readln;
      exit;
    end
  else
    reset(f);
end;
 
 
{просмотр файла}
procedure ReadFile(var f: TfileM);
var
  Mon: TMonety;
begin
  clrscr;
  Reset(f);
  writeln('Полный список монет:':40);
  writeln;
  Tabl;
  while not eof(f) do
    begin
      read(f,Mon);
      OutInfo(Mon);
    end;
  writeln('-------------------------------------------------------------------------');
  writeln('Нажмите Enter');
  readln;
  close(f);
end;
 
 
{замена записи}
procedure Zamena(var f: TfileM);
var
  n: integer;
  Mon: TMonety;
begin
  clrscr;
  ResetFile(f,b);
  write('Номер записи для замены n = ');
  readln(n);
  if(n < 1) or (filesize(f) < n) then
    begin
      writeln('В файле нет такой записи!');
      readln;
      exit;
    end;
  writeln('Введите новые сведения о монете:');
  InfInRec(Mon);
  seek(f,n-1);
  write(f,Mon);
  close(f);
  writeln('Нажмите Enter');
  readln
end;
 
 
{добавление записи}
procedure Add(var f: TfileM);
var
  Mon: TMonety;
begin
  clrscr;
  ResetFile(f,b);
  writeln('Введите сведения о добавляемой монете:');
  InfInRec(Mon);
  seek(f,filesize(f));
  write(f,Mon);
  close(f);
  writeln('Нажмите Enter');
  readln
end;
 
 
{поиск по наименованию}
procedure PoiskName(var f:TfileM);
var
  Mon: TMonety;
  k: boolean;
  s: string;
begin
  clrscr;
  ResetFile(f,b);
  writeln('Введите имя искомой монеты: ');
  Readln(s);
  writeln('Найденные по наименованию монеты: ' );
  k:= false;
  Tabl;
while not eof(f) do
  begin
   read(f,Mon);
   if (mon.namemonety = s) then
     begin
       k:= true;
       OutInfo(Mon);
    end;
  end;
  writeln('-------------------------------------------------------------------------');
  if k then
    writeln('Монет с таким наименованием не найдено!');
  writeln('Нажмите Enter');
  readln;
  close(f);
end;
 
 
{поиск по государству выпускавшему монету}
procedure PoiskState(var f: TfileM);
var
  Mon: TMonety;
  k: boolean;
  s: string;
begin
  clrscr;
  ResetFile(f,b);
  writeln('Введите название государства, выпускавшему монету: ');
  Readln(s);
  writeln('Найденные по наименованию государства моенты: ' );
  k:= false;
  Tabl;
while not eof(f) do
  begin
   read(f,Mon);
   if (mon.state = s) then
     begin
       k:= true;
       OutInfo(Mon);
    end;
  end;
  writeln('-------------------------------------------------------------------------');
  if k then
    writeln('Монет с таким наименованием не найдено!');
  writeln('Нажмите Enter');
  readln;
  close(f);
end;
 
{поиск по месту находки}
procedure PoiskPlace(var f: TfileM);
var
  Mon: TMonety;
  k: boolean;
  s: string;
begin
  clrscr;
  ResetFile(f,b);
  writeln('Введите название места, где была найдена монета: ');
  Readln(s);
  writeln('Найденные по месту нахождения монеты: ' );
  k:= false;
  Tabl;
while not eof(f) do
  begin
   read(f,Mon);
   if (mon.place = s) then
     begin
       k:= true;
       OutInfo(Mon);
    end;
  end;
  writeln('-------------------------------------------------------------------------');
  if k then
    writeln('Монет с таким наименованием не найдено!');
  writeln('Нажмите Enter');
  readln;
  close(f);
end;
 
{поиск по состоянию монеты}
procedure PoiskCondition(var f: TfileM);
var
  Mon: TMonety;
  k: boolean;
  s: string;
  j: Byte;
begin
  clrscr;
  ResetFile(f,b);
  writeln('Введите оценку состояния монеты: ');
  writeln('Выберете степень состояния монеты выбрав цифру: ');
  writeln('1 - очень плохое');
  writeln('2 - плохое');
  writeln('3 - удовлетворительное');
  writeln('4 - хорошее');
  writeln('5 - отличное');
  readln(j);
  Case j of
  1: s:= 'очень плохое';
  2: s:= 'плохое';
  3: s:= 'удовлетворительное';
  4: s:= 'хорошее';
  5: s:= 'отличное';
  end;
  writeln('Найденные по монеты по оценке состояния: ' );
  k:= false;
  Tabl;
while not eof(f) do
  begin
   read(f,Mon);
   if (mon.Condition = s) then
     begin
       k:= true;
       OutInfo(Mon);
    end;
  end;
  writeln('-------------------------------------------------------------------------');
  if k then
    writeln('Монет с таким наименованием не найдено!');
  writeln('Нажмите Enter');
  readln;
  close(f);
end;
 
 
var
  f: TfileM;
  w: char;
begin
  clrscr;
  assign(f,fname);
  b:= false;
  repeat
    clrscr;
    writeln('Выберите действие:');
    writeln('1-создать новый файл');
    writeln('2-просмотреть весь файл');
    writeln('3-изменить запись');
    writeln('4-добавить запись');
    writeln('5-найти монету по наименованию');
    writeln('6-найти монету по государству происхождения');
    writeln('7-найти монету по месту находки');
    writeln('8-найти монету по ее состоянию');
    writeln('другое-выход');
    readln(w);
  case w of
  '1': CreateFile(f);
  '2': Readfile(f);
  '3': Zamena(f);
  '4': Add(f);
  '5': PoiskName(f);
  '6': PoiskState(f);
  '7': PoiskPlace(f);
  '8': PoiskCondition(f);
   else
     exit;
  end;
  until not (w in ['1'..'8']);
end.