Program bibka;
  uses CRT,graph;
  Type kniga=record
  ISBN:integer;
  avtor:string;
  nazvanie:string;
  izdatelstvo:string;
  god:integer;
  obem:integer;
  end;
  function p(a:string; n:byte):string;
  var i: byte; 
  begin  
  for i:=1 to n-length(a) do a:=a+' '; 
  p:=a; 
  end;   
  var f,fn:file of kniga;
  a,x,j:kniga;n:array[1..5] of kniga;
  i:byte;w,k:integer;
  y:char;
  procedure OutMenu;
  begin  clrscr;
  TextColor(15);
  writeln('1 - Create file');
  writeln('2 - Print to screen'); 
  writeln('3 - Add record to file');
  writeln('4 - Delete record by ISBN'); 
  writeln('5 - Change of record');
  writeln('6 - Sortirovka');
  writeln('7 - Text file');
  writeln('8 - Diagramma');
  writeln('9 - Exit');
  writeln('0 - Stat');
  writeln;
  write('Type number ');
  end;
  procedure create; 
  begin 
  clrscr;
  writeln('Procedure create');
  n[1].ISBN:=1; 
  n[1].avtor:='Ivanov I.I.';
  n[1].nazvanie:='zhivopis';
  n[1].izdatelstvo:='ruskniga';
  n[1].god:=1990; 
  n[1].obem:=246;  
  n[2].ISBN:=2; 
  n[2].avtor:='Petrov P.V.';
  n[2].nazvanie:='live'; 
  n[2].izdatelstvo:='prosv';
  n[2].god:=1994; 
  n[2].obem:=53; 
  n[3].ISBN:=3;
  n[3].avtor:='Sidorov S.P.';
  n[3].nazvanie:='viy'; 
  n[3].izdatelstvo:='pechat'; 
  n[3].god:=2004;  
  n[3].obem:=246;  
  n[4].ISBN:=4;
  n[4].avtor:='Kuznecov V.A.';
  n[4].nazvanie:='skazki'; 
  n[4].izdatelstvo:='prosv'; 
  n[4].god:=1999; 
  n[4].obem:=34; 
  n[5].ISBN:=5; 
  n[5].avtor:='Denisov A.A. '; 
  n[5].nazvanie:='stixi'; 
  n[5].izdatelstvo:='ruskniga'; 
  n[5].god:=2006; 
  n[5].obem:=85; 
  assign(f,'c:\zap.tmp');  
  rewrite(f); 
  for i:=1 to 5 do    write(f,n[i]); 
  close(f);   
  reset(f);   
  while not eof(f) do    read(f,x);
  close(f); 
  writeln('Press ENTER'); 
  readln; 
  end; 
  procedure vivod;
  var i:byte; 
  begin  clrscr; 
  TextColor(2); 
  writeln('              file kniga              ');
  TextColor(8);  
  writeln('ISBN','    avtor    ','    nazvanie ','     izdatelstvo','      god ','      obem'); 
  TextColor(5); 
  reset(f); 
  i:=1; 
  while not eof(f) do    begin    read(f,x); 
  with x do    writeln(ISBN,'     ',p(avtor,15),p(nazvanie,15),izdatelstvo:10,god:10  ,obem:10); 
  i:=i+1;
  end;   
  close(f); 
  writeln;   
  TextColor(6); 
  writeln('Press Enter');  
  readln; 
  end; 
  procedure add;
  begin  clrscr;
  writeln('Procedure of add'); 
  writeln('Vvedite zapis'); 
  reset(f);  seek(f,filesize(f)); 
  x.ISBN:=w+1;  
  with x do begin  writeln('avtor'); 
  readln(avtor);
  writeln('nazvanie'); 
  readln(nazvanie); 
  writeln('izdatelstvo');
  readln(izdatelstvo);
  writeln('god'); 
  readln(god); 
  writeln('obem'); 
  readln(obem); 
  end;  write(f,x); 
  w:=x.ISBN; 
  close(f); 
  writeln('Press ENTER');
  readln; 
  end; 
  procedure delete; 
  begin  clrscr; 
  writeln('Procedure delete record by ISBN '); 
  assign(fn,'c:\temp'); 
  reset(f); 
  rewrite(fn); 
  write('What record to delete');
  readln(i);
  while not eof(f) do begin  read(f,j); 
  if j.ISBN<>i then write (fn,j);
  end;
  close(f); 
  close(fn); 
  erase(f); 
  rename(fn,'c:\zap.tmp'); 
  writeln('Press ENTER'); 
  readln;  end;  procedure change;
  var r:integer;  
  begin  clrscr;
  writeln('Procedure changing'); 
  with a do begin  writeln('ISBN');
  readln(ISBN); 
  writeln('avtor'); 
  readln(avtor); 
  writeln('nazvanie'); 
  readln(nazvanie);  
  writeln('izdatelstvo'); 
  readln(izdatelstvo); 
  writeln('god'); 
  readln(god); 
  writeln('obem');  
  readln(obem);  
  end;  r:=a.ISBN; 
  reset(f);  
  seek(f,r-1);  
  write(f,a);  
  close(f); 
  writeln('Press ENTER');  
  readln; 
  end;  
  procedure sort;  
  var i,j:byte; 
  k,x:kniga; 
  begin  clrscr; 
  writeln('Procedure sort'); 
  reset(f); 
  for i:=0 to filesize(f)-2 do  
  for j:=i+1 to filesize(f)-1 do 
  begin  seek(f,i);
  read(f,k);
  seek(f,j);
  if k.god<x.god then begin  seek(f,i);
  write(f,x); 
  seek(f,j); 
  write(f,k);  
  end;
  end; 
  writeln('Press ENTER'); 
  readln; 
  end; 
  procedure textf;  
  var f1:text;f:file of kniga;
  st,st1,st2,st3:string;c:kniga;g:integer;z:integer; 
  begin  clrscr; 
  writeln('Procedure text');
  writeln('        text file for kniga novee 2000 goda              ');  
  TextColor(5);   
  writeln(' ISBN  ','avtor         ','nazvanie  ','izdatelstvo','     ','obem');
  TextColor(12); 
  assign(f,'c:\zap.tmp'); 
  reset(f);  
  assign(f1,'c:\txt'); 
  rewrite(f1); 
  while not eof(f) do begin  read(f,c); 
  if c.god>2000 then begin  str(c.ISBN,st1);
  g:=c.god; 
  str(g,st2); 
  z:=c.obem; 
  str(z,st3); 
  st:='   '+st1+'   '+P(c.avtor,15)+P(c.nazvanie,10)+'  '+st2+'         '+st3+''; 
  writeln(f1,st); 
  end;end;  
  begin close(f1);  
  reset(f1);   
  while not eof(f1) do begin   readln(f1,st); 
  writeln(st);  
  end;
  end; 
  TextColor(15); 
  writeln('Press ENTER'); 
  readln;  
  end; 
  procedure diagramma; 
  VAR  kol:array[1..100] of integer; 
  obem:array[1..100] of integer; 
  flag:boolean;j,n,i,gd,gm,ec,x,y, s,b,r:integer;
  k:kniga;ST5,ST6:STRING; 
  begin  clrscr; 
  writeln('procedure diagramma'); 
  r:=210; 
  n:=0; 
  assign(f,'c:\zap.tmp'); 
  reset(f);  
  while not eof(f) do begin   read(f,k); 
  flag:=false; 
  for i:=1 to n do  
  if obem[i]=k.obem then begin 
  flag:=true;  
  kol[i]:=kol[i]+1; 
  end;  
  if flag=false then begin n:=n+1;  
  obem[n]:=k.obem; 
  kol[n]:=1;
  end;  
  end;  
  gd:=detect; 
  initgraph(gd,gm,'d:\bp\bgi\');   
  SetColor(10);  
  ST5:='balli po fizike'; 
  OUTTEXTXY(30,2,ST5); 
  s:=filesize(f);  
  b:=0;  
  for i:=1 to n do 
  begin   setfillstyle(7,i+1);  
  if i=n then pieslice(getmaxx div 2,getmaxy div 2, b, 360,r) 
  else   pieslice(getmaxx div 2, getmaxy div 2, b, trunc(b+kol[i]/s*360),r);
  b:=trunc(b+kol[i]/s*360);  
  X:=40;Y:=20+I*20;  
  STR(obem[i],ST6);  
  OUTTEXTXY(X,Y,ST6);  
  BAR(X-20,Y,X-10,Y+10); 
  end;    
  readln; 
  CLOSEGRAPH; 
  end;   
  procedure stat; 
  var     o :integer; 
  begin       clrscr;   
  WriteLn('                         Statistika:');   
  textcolor(green);    
  kolv:=1;    
  o:=arr[1].obem;   
  iz[1].name:=arr[1].izd;   
  iz[1].kol:=1;    
  for i:=2 to n do 
  begin      
  o:=o+arr[i].obem;     
  t:=0;          
  for j:=1 to kolv do if arr[i].izd=iz[j].name then t:=j;  
  if t<>0 then inc(iz[t].kol) else  
  begin        
  inc(kolv);      
  iz[kolv].name:=arr[i].izd;   
  iz[kolv].kol:=1;   
  end;      
  end;     
  for i:=1 to kolv do Writeln('Imeetsya ',iz[i].kol,' knig(a) ',iz[i].name,' izdatel"stvo');  
  writeln;   
  writeln;   
  textcolor(4); 
  Writeln('Srednij ob"em vseh knig: ',o div n);  
  textcolor(9); 
  writeln('                            press any key'); 
  textcolor(white);  
  readkey;  
  end;
  begin  w:=5; 
  assign(f,'c:\zap.tmp'); 
  repeat  OutMenu;  
  readln(y);  
  case y of  '1':create;
  '2':vivod;  
  '3':add; 
  '4':delete; 
  '5':change; 
  '6':sort; 
  '7':textf; 
  '8':diagramma;
  '0':stat;
  end; 
  until y='9'; 
  end.