Файл содержит сведения об ассортименте игрушек в магазине. Вывести информацию по определенным критериям — Pascal(Паскаль)

Каждая запись содержит поля: название игрушки, цена, количество, возрастные границы (2-5);

Написать программу, которая позволяет:
1. Сформировать файл;
2. Выводит список игрушек, которые подходят детям от 1 года до 3 лет в алфавитном порядке;
3. Выводит стоимость самой дорогой игрушки и ее наименование.

program PascalGuru;

uses crt;

Type
  vozrgr = 2 .. 5;

  igrushki = record
    nazv: string;
    cena: real;
    kol: integer;
    vg: vozrgr;
  end;

var
  f: text;
  nazv: string;
  cena: real;
  kol: integer;
  vg: vozrgr;

procedure menu; forward;

procedure p1;
var
  n, i: integer;
begin
  clrscr;
  assign(f, 'db.txt');
  rewrite(f);
  write('Skoliko zapisei xotite dobaviti: ');
  readln(n);
  for i := 1 to n do
  begin
    clrscr;
    writeln('Zapisi #', i, ':');
    write('Nazvanie igrushki: ');
    readln(nazv);
    writeln(f, nazv);
    write('Tsena: ');
    readln(cena);
    writeln(f, cena:0:2);
    write('Kolichestvo: ');
    readln(kol);
    writeln(f, kol);
    write('Vozrastnye granitsy (2-5): ');
    readln(vg);
    writeln(f, vg);
  end;
  writeln('Dannye uspeshno zapisany...');
  close(f);
  readln;
  menu;
end;

{ -------------------------------------------- }
procedure exchange(var a, b: string);
var
  c: string;
begin
  c := a;
  a := b;
  b := c;
end;

procedure exchangevg(var a, b: vozrgr);
var
  c: vozrgr;
begin
  c := a;
  a := b;
  b := c;
end;

procedure p2;
var
  n, nn, i, j: integer;
  massiv: array [1 .. 30] of igrushki;
  swop: boolean;
  l, s: string;
begin
  clrscr;
  assign(f, 'db.txt');
  reset(f);
  n := 0;
  while not eof(f) do
  begin
    readln(f, nazv);
    readln(f, cena);
    readln(f, kol);
    readln(f, vg);
    if vg <= 3 then
    begin
      inc(n);
      massiv[n].nazv := nazv;
      massiv[n].vg := vg;
    end;
  end;

  nn := n;

  repeat
    swop := false;
    for j := 1 to n - 1 do
    BEGIN
      i := 1;
      l := massiv[j].nazv;
      s := massiv[j + 1].nazv;
      While (i <= 3) and (l[i] = s[i]) do
        inc(i);
      If i > 3 then
        writeln('the same')
      else if ord(l[i]) > ord(s[i]) then
      begin
        exchange(massiv[j + 1].nazv, massiv[j].nazv);
        exchangevg(massiv[j + 1].vg, massiv[j].vg);
        swop := true;
      end;
    END;
    n := n - 1;
  until not swop;
  { *** }
  for i := 1 to nn do
    writeln(massiv[i].nazv, ' * ', massiv[i].vg);

  close(f);
  readln;
  menu;
end;
{ -------------------------------------------- }

procedure p3;
var
  n, i: integer;
  massiv: array [1 .. 30] of igrushki;
  max: real;
  maxn: string;

begin
  clrscr;
  assign(f, 'db.txt');
  reset(f);
  n := 0;
  while not eof(f) do
  begin
    readln(f, nazv);
    readln(f, cena);
    readln(f, kol);
    readln(f, vg);
    inc(n);
    massiv[n].nazv := nazv;
    massiv[n].cena := cena;
  end;

  max := massiv[1].cena;
  maxn := massiv[1].nazv;
  for i := 2 to n do
    if massiv[i].cena > max then
    begin
      max := massiv[i].cena;
      maxn := massiv[i].nazv;
    end;

  writeln(maxn, ' - stoit ', max:0:2);
  close(f);
  readln;
  menu;
end;
{ -------------------------------------------- }

procedure menu;
var
  option: integer;
begin
  clrscr;
  writeln('------');
  writeln('-MENU-');
  writeln;
  writeln('1 Sformirovati fail');
  writeln('2 Vyvodit spisok igrushek, podhodyascie detyam ot 1 goda do 3 let');
  writeln('3 Vyvodit stoimosti samoi dorogoi igrushki i ee naimenovanie');
  writeln;
  writeln;
  writeln('0 EXIT');
  readln(option);
  if option = 1 then
    p1;
  if option = 2 then
    p2;
  if option = 3 then
    p3;

end;

{ ******************************************* }
begin
  menu;

end.

Leave a Comment

− 2 = 2