q1p
05.06.2008, 20:34
Есть 2 программы на паскале может кто помочь встроить в программу один пункт и добавить его в меню вывода?
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; 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); read(f,x); 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; 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; end; until y='9'; 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;
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; 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); read(f,x); 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; 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; end; until y='9'; 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;