помогите с прогой на паскаль

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by q1p, 5 Jun 2008.

  1. q1p

    q1p Elder - Старейшина

    Joined:
    29 Apr 2008
    Messages:
    0
    Likes Received:
    4
    Reputations:
    0
    Есть 2 программы на паскале может кто помочь встроить в программу один пункт и добавить его в меню вывода?
    HTML:
    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.
    Вставить в выше написанную программу надо
    HTML:
    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;
     
    #1 q1p, 5 Jun 2008
    4 people like this.
  2. 0verbreaK

    0verbreaK Elder - Старейшина

    Joined:
    30 Apr 2008
    Messages:
    318
    Likes Received:
    42
    Reputations:
    -3
    Нормально ввести немог, её переводить в рабочее состояние еще надо
     
    #2 0verbreaK, 5 Jun 2008
  3. q1p

    q1p Elder - Старейшина

    Joined:
    29 Apr 2008
    Messages:
    0
    Likes Received:
    4
    Reputations:
    0
    верхняя рабочая полностью программа
     
    #3 q1p, 5 Jun 2008
  4. Fata1ex

    Fata1ex Elder - Старейшина

    Joined:
    12 Dec 2006
    Messages:
    703
    Likes Received:
    300
    Reputations:
    38
    Создавай тему: нужен скрипт для приведения моих программ в нормальный вид(
     
    #4 Fata1ex, 5 Jun 2008
    1 person likes this.
  5. n3m0

    n3m0 Elder - Старейшина

    Joined:
    11 May 2007
    Messages:
    133
    Likes Received:
    92
    Reputations:
    11
    Не словом, а ділом (с) Ю.
    ЗЫ Украинцы поймут меня


    Попробовал тебе преобразовать

    Code:
    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.

    PS: В меню выбора пишеш "0". Это и есть твое новое меню
     
    #5 n3m0, 5 Jun 2008
    1 person likes this.
  6. q1p

    q1p Elder - Старейшина

    Joined:
    29 Apr 2008
    Messages:
    0
    Likes Received:
    4
    Reputations:
    0
    n3m0, не запускается
     
    #6 q1p, 5 Jun 2008
  7. q1p

    q1p Elder - Старейшина

    Joined:
    29 Apr 2008
    Messages:
    0
    Likes Received:
    4
    Reputations:
    0
    там надо переменные задать в меню описания переменных в этом и проблемма
     
    #7 q1p, 5 Jun 2008
  8. 0verbreaK

    0verbreaK Elder - Старейшина

    Joined:
    30 Apr 2008
    Messages:
    318
    Likes Received:
    42
    Reputations:
    -3
    initgraph(gd,gm,'d:\bp\bgi\');

    проверь путь к bgi
     
    #8 0verbreaK, 6 Jun 2008
(You must log in or sign up to post here.)