Информация о продаже товаров подготовлена по следующему макету: номер магазина; номер секции; номер чека; наименование товара; артикул товара; цена товара; количество то- вара; дата продажи. Составить программу определения объема товарооборота по каждому ма- газину, т.е. общую сумму, вырученную от продажи всех товаров в данном магазине (данные содержат записи по нескольким магазинам). Разработать форму выходного документа.- Pascal(Паскаль)

program kurs;
uses dos,crt;
 
type
Ptabl = ^Ttabl;
tablinf = record
            numm:string[10];
            nums:string[10];
            numc:integer;
            tov:string[15];
            artt:integer;
            st:integer;
            kol:integer;
            data:string[10];
            tovob:integer;
          end;
 
 
Ttabl=record
            inf:tablinf;
            next,prev:Ptabl;
          end;
 
var
kolchek:array [1..100] of tablinf;
newe:tablinf;
temp,left,right,tabl:Ptabl;
j,c,starty,perc,i,cur,beg,lin,lnum,count:integer;
ch:char;
 
function getp(n:integer):ptabl;
var
  c:integer;
  el:Ptabl;
begin
  c := 1;
  el := left;
  while c<>n do
  begin
    inc(c);
    el := el^.next;
  end;
  getp := el;
end;
 
function inttostr(i:longint):string;
var
  s:string[11];
begin
  str(i,s);
  inttostr := S;
end;
 
function strtoint(s:string):longint;
var
  i,code:integer;
begin
  while s[1]=' ' do delete(s,1,1);
  while s[length(s)]=' ' do delete(s,length(s),1);
  val(s,i,code);
  strtoint := i;
end;
 
procedure flip(var t1,t2:ptabl);
var
  d:tablinf;
begin
  d := t1^.inf;
  t1^.inf := t2^.inf;
  t2^.inf := d;
end;
 
procedure sort(t:integer);
var
  temp1,temp2:ptabl;
  s,i,j:integer;
begin
  s := 1;
  for i := 1 to count do
  for j := 1 to count do begin
    temp1 := getp(i);
    temp2 := getp(j);
    if s=2 then
    case t of
      1:if temp1^.inf.numm>temp2^.inf.numm then flip(temp1,temp2);
      2:if temp1^.inf.nums>temp2^.inf.nums then flip(temp1,temp2);
      3:if temp1^.inf.numc>temp2^.inf.numc then flip(temp1,temp2);
      4:if temp1^.inf.tov>temp2^.inf.tov then flip(temp1,temp2);
      5:if temp1^.inf.artt>temp2^.inf.artt then flip(temp1,temp2);
      6:if temp1^.inf.st>temp2^.inf.st then flip(temp1,temp2);
      7:if temp1^.inf.kol>temp2^.inf.kol then flip(temp1,temp2);
      8:if temp1^.inf.data>temp2^.inf.data then flip(temp1,temp2);
    end else
    if s=1 then
    case t of
      1:if temp1^.inf.numm>temp2^.inf.numm then flip(temp1,temp2);
      2:if temp1^.inf.nums>temp2^.inf.nums then flip(temp1,temp2);
      3:if temp1^.inf.numc>temp2^.inf.numc then flip(temp1,temp2);
      4:if temp1^.inf.tov>temp2^.inf.tov then flip(temp1,temp2);
      5:if temp1^.inf.artt>temp2^.inf.artt then flip(temp1,temp2);
      6:if temp1^.inf.st>temp2^.inf.st then flip(temp1,temp2);
      7:if temp1^.inf.kol>temp2^.inf.kol then flip(temp1,temp2);
      8:if temp1^.inf.data>temp2^.inf.data then flip(temp1,temp2);
    end;
  end;
end;
 
procedure org;
var
  f:text;
begin
  assign(f,'base.txt');
  reset(f);
  read(f,newe.numm);
  if newe.numm='666' then exit;
  read(f,newe.nums);read(f,newe.numc);
  read(f,newe.tov);read(f,newe.artt);
  read(f,newe.st);read(f,newe.kol);
  read(f,newe.data);
  new(tabl);
  tabl^.inf := newe;
  tabl^.next := nil;
  tabl^.prev := nil;
  left := tabl;
  right := tabl;
  readln(f);
  count := 1;
  while true do begin
    read(f,newe.numm);
    if newe.numm='666' then exit;
    read(f,newe.nums);read(f,newe.numc);
    read(f,newe.tov);read(f,newe.artt);
    read(f,newe.st);read(f,newe.kol);
    read(f,newe.data);
    new(tabl);
    tabl^.inf := newe;
    tabl^.next := nil;
    tabl^.prev := right;
    right^.next := tabl;
    right := tabl;
    inc(count);
    readln(f);
  end;
  close(f);
end;
 
procedure show;
begin
  textbackground(0);
  if lnum<20 then clrscr;
  textcolor(15);
  textbackground(3);
  gotoxy(1,starty);
  writeln('----------T-------T-----T-----T-------T---------T------T------------¬');
  writeln('¦№МагазинহСекци覹Чека¦Товар¦Артикул¦Стоимость¦Кол-во¦Дата продажи¦');
  writeln('+---------+-------+-----+-----+-------+---------+------+------------+');
  gotoxy(1,starty + 3);
  temp := getp(beg);
  for i := 1 to lnum do
    begin
      if i=lin then
        begin
          textcolor(1);
          textbackground(6);
          with temp^.inf do
          writeln('¦ ',numm,' ¦ ',nums,' ¦ ',numc,' ¦ ',tov,' ¦ ',artt,' ¦ ',st,' ¦ ',kol,' ¦ ',data,' ¦');
          textcolor(15);
          textbackground(3);
        end else
      with temp^.inf do
      writeln('¦ ',numm,' ¦ ',nums,' ¦ ',numc,' ¦ ',tov,' ¦ ',artt,' ¦ ',st,' ¦ ',kol,' ¦ ',data,' ¦');
      temp := temp^.next;
    end;
    writeln('L---------+-------+-----+-----+-------+---------+------+------------+');
    textcolor(7);
    textbackground(0);
    gotoxy(1,starty + lnum + 5);
    writeln('Запись №',cur:2,' из ',count);
    write('''S''-Сортировать ''A''-Добавить ''E''-Редактировать ''D''-Удалить ''I''-Таблица');
end;
 
procedure saveto;
var
  f:text;
begin
  assign(f,'out.txt');
  rewrite(f);
  temp := getp(beg);
  while temp<>nil do
  with temp^.inf do
    begin
      write('¦ ',numm,' ¦ ',nums,' ¦ ',numc,' ¦ ',tov,' ¦ ',artt,' ¦ ',st,' ¦ ',kol,' ¦ ',data,' ¦');
      temp := temp^.next;
    end;
  close(f);
end;
 
procedure add;
var
 l,p,er:integer;
 lt,sto:string;
begin
  textbackground(0);
  clrscr;
  writeln('Добавление:');
  write('№ магазина:');
  readln(sto); if length(sto)<6 then for p := 1 to 6-length(sto) do sto := sto + ' ';
  newe.numm := sto;
  write('№ Секции:');
  readln(sto); if length(sto)<6 then for p := 1 to 6-length(sto) do sto := sto + ' ';
  newe.nums := sto;
  write('№ Чека:');
  readln(l);newe.numc := l;
  write('Товар:');
  readln(l); newe.tov := lt;
  write('Артикул товара:');
  readln(l); newe.artt := l;
  write('стоимость:');
  readln(l); newe.st := l;
  write('Количество:');
  readln(l); newe.kol := l;
  write('Дата продажи:');
  readln(l); newe.data := lt;
  new(tabl);
  tabl^.inf := newe;
  tabl^.next := nil;
  tabl^.prev := right;
  right^.next := tabl;
  right := tabl;
  inc(count);
  if count<=20 then lnum:=count;
  clrscr;
end;
 
procedure edit;
var
  l,p,er:integer;
 lt,st:string;
begin
  textbackground(0);
  clrscr;
  writeln('Редактирование:');
  write('№ магазина:');
  readln(st); if length(st)<6 then for p := 1 to 6-length(st) do st := st + ' ';
  newe.numm := st;
  write('№ Секции:');
  readln(st); if length(st)<6 then for p := 1 to 6-length(st) do st := st + ' ';
  newe.nums := st;
  write('№ Чека:');
  readln(l);newe.numc := l;
  write('Товар:');
  readln(l); newe.tov := lt;
  write('Артикул товара:');
  readln(l); newe.artt := l;
  write('стоимость:');
  readln(l); newe.st := l;
  write('Количество:');
  readln(l); newe.kol := l;
  write('Дата продажи:');
  readln(l); newe.data := lt;
  textbackground(0);
  clrscr;
end;
 
procedure del;
begin
  if count>1 then begin
  if cur=1 then
  begin
    temp := left^.next;
    temp^.prev := nil;
    dispose(left);
    left := temp;
    dec(count);
  end else
  if cur=count then
  begin
    temp := right^.prev;
    temp^.next := nil;
    dispose(right);
    right := temp;
    dec(count);
    dec(beg);
  end else
  begin
    temp := getp(cur);
    temp^.prev^.next := temp^.next;
    temp^.next^.prev := temp^.prev;
    dispose(temp);
    dec(count);
  end;
  lin := 1;
  beg := 1;
  if count<lnum then lnum:=count;
  end;
end;
 
function sortby:integer;
var
  c:char;
  i,lp:integer;
begin
  textbackground(0);
  clrscr;
  writeln('Сортировать:');
  writeln('1: № Магазина');
  writeln('2: № Секции');
  writeln('3: № Чека');
  writeln('4: Товар');
  writeln('5: Артикул товара');
  writeln('6: Стоимость');
  writeln('7: Кол-во');
  writeln('8: Дата');
  readln(lp);
  if lp>8 then lp:=8;
  if lp<1 then lp:=1;
  sortby := lp;
  clrscr;
end;
 
procedure inf;
var
  n:integer;
  old,new:integer;
  s,p: real;
begin
  sort(1);
  temp := left;
  n := 1;
   
  while temp<>nil do
  begin
    if kolchek[n].numm=temp^.inf.numm
    then begin
      kolchek[n].st := kolchek[n].st + temp^.inf.st;
      kolchek[n].kol := kolchek[n].kol + temp^.inf.kol;
     end else
    begin
      inc(n);
      kolchek[n] := temp^.inf;
    end;
    temp := temp^.next;
  end;
 
  for i:=1 to n do
  begin
 
  end;
 
  textbackground(0);
  clrscr;
  textcolor(15);textbackground(3);
  writeln('г============T============T================¬');
  writeln('¦ № Магазина ¦  № Секции  ¦  Товарооборот  ¦');
  writeln('¦============+============+================¦');
  for i := 1 to n do
  begin
    p:=kolchek[i].st*kolchek[i].kol;
    writeln('¦ ',kolchek[i].numm,' ¦ ',kolchek[i].nums,' ¦ ',p,' ¦ ');
   end;
    writeln('L==========¦============¦================¦');
  readkey;
end;
 
procedure close;
begin
  saveto;
  clrscr;
  halt(1);
end;
 
procedure main;
begin
  repeat
    if keypressed then
    begin
      ch := readkey;
      if ch=#71 then {home}
        begin
          lin := 1;beg := 1;
        end;
        if ch=#79 then {end}
        begin
         lin := lnum;beg := count-lnum + 1;
        end;
        if (ch=#73) then {pageup}
        begin
          lin := 1;
          beg := beg-lnum;
          if beg<1 then beg := 1;
        end;
        if (ch=#81) then {pagedown}
        begin
          lin := lnum;
          beg := beg + lnum;
          if beg>(count-lnum) then beg := count-lnum + 1;
        end;
        if ch=#80 then {down}
          begin
            inc(lin);
            if lin>lnum then
            begin
              lin := lnum;
              if (beg + lnum)<=count then inc(beg);
            end;
          end;
        if ch=#72 then {up}
        begin
          dec(lin);
          if lin<1 then
          begin
            lin := 1;
            if beg>1 then dec(beg);
          end;
        end;
        if (ch='s') or (ch='ы') then sort(sortby);
        if (ch='a') or (ch='ф') then add;
        if (ch='e') or (ch='у') then edit;
        if (ch='d') or (ch='в') then del;
        if (ch='i') or (ch='ш') then inf;
      cur := beg + lin-1;
      show;
    end;
  until ch=#27;
end;
 
begin
  textbackground(0);
  clrscr;
  lnum := 20;
  starty := 1;
  beg := 1;
  lin := 1;
  cur := 1;
  org;
  show;
  main;
  close;
end.