Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.06.2018, 15:05   #1
Pina
Новичок
Джуниор
 
Регистрация: 02.12.2017
Сообщений: 2
По умолчанию помогите пожалуйста дописать программу в паскале

Нужно, чтобы в диаграмме выводилось в процентах сколько 5,4 и тд. по суммарному баллу по физике(r.fiz) + математике (r.mat). Сама программа :
Код:
uses GraphABC;
Function G (s:string;n:real):string; 
begin
while length(s)<n do s:=s+' ';
result:=s;
end;
type TSt = record 
name: string[20]; 
num: string[20];
fiz: word;
mat: word;
rus: string[20];
end; 
var  a:array[1..5] of TSt; i:integer;
 f: file of TSt;
 c:integer;
  Procedure CreateFile;
 var r:TSt;
begin 
rewrite(f); 
r.name:='Вероника Лодж   '; r.num:='17СО7'; r.mat:=4; r.fiz:=5; r.rus:='зачет'; write(f,r);
r.name:='Арчибальд Эндрюс'; r.num:='19СО6'; r.mat:=4; r.fiz:=3; r.rus:='зачет'; write(f,r);
r.name:='Бетти Купер     '; r.num:='15СО9'; r.mat:=5; r.fiz:=5; r.rus:='незачет';write(f,r);
r.name:='Джагхед Джонс   '; r.num:='11СО3'; r.mat:=4; r.fiz:=2; r.rus:='зачет';write(f,r);
r.name:='Кевин Келлер    '; r.num:='18СО4'; r.mat:=3; r.fiz:=3; r.rus:='незачет';write(f,r);
close(f);
end; 
Procedure OutFile; 
 var r:TSt;
   begin
   Reset(f);
    while not eof(f)do
    begin
    read(f,r);
     writeln (r.Name:20, '      ', G(r.num,15),(r.mat:15),(r.fiz:15),G(r.rus,5));
    end;
    Close(f);
   end;
procedure AddRecord; 
var r: TSt; 
begin 
writeln ('Введите ФИО'); readln (r.name); 
writeln ('Введите номер студ. билета'); readln (r.num);
writeln ('Введите оценки по математике'); readln (r.mat); 
writeln ('Введите оценки по физике'); readln (r.fiz);
writeln ('Введите оценки по русскому'); readln (r.rus);
 
reset (f); 
seek (f, filesize (f));
write(f,r);
close (f);
end; 
procedure EditRecord; 
var r:TSt; 
nf,nr:integer;
begin 
reset (f); 
 writeln ('Введите номер записи:'); readln(nf);
 writeln ('0 - все поля');
 writeln ('1 - ФИО');
 writeln ('2 - номер студ. билета');
 writeln ('3 - оценки по математике');
 writeln ('4 - оценки по физике');
 writeln ('5 - оценки по русскому');
 writeln ('Введите номер записи:'); readln(nf);
           
            seek (f,nr-1);
            read(f,r);
            if (nf=0) or (nf=1) then begin writeln ('Введите ФИО'); readln (r.name); end;
            if (nf=0) or (nf=2) then begin writeln ('Введите номер студ. билета'); readln (r.num); end;
            if (nf=0) or (nf=3) then begin writeln ('Введите оценки по математике'); readln (r.mat); end;
            if (nf=0) or (nf=3) then begin writeln ('Введите оценки по физике'); readln (r.fiz);end;
            if (nf=0) or (nf=3) then begin writeln ('Введите оценки по русскому'); readln (r.rus);end;
           
            seek (f,nr-1);
            read(f,r);
            close(f);
            end;
           
procedure DeltRecord; 
  var r:TSt; nr:integer;
    begin
            reset (f);
            writeln ('Введите номер записи:'); readln(nr);
            while nr < filesize (f) do
       begin
            seek (f,nr);
            read (f,r);
            seek (f, nr-1);
            write(f,r);
            nr:=nr+1;
       end;
truncate(f);
close (f);  
end; 
Procedure SortRecord; 
var b: boolean; 
    i,n: integer;
    r1, r2: TSt;
 begin
   reset (f);
  writeln('1 - Сортировать по имени');
  writeln('2 - Сортировать по номеру студ. билета');
  writeln('3 - Сортировать по оценкам по математики');
  writeln('4 - Сортировать по оценкам по физике');
  writeln('5 - Сортировать по оценкам по русскому');
  readln(n);
  if (n=0) or ( n=1) then
   begin
   repeat
     b:=false;
      for i:=1 to filesize(f)-1 do
       begin
        seek (f,i-1);
        read (f, r1,r2);
         if r1.name>r2.name then
           begin
            seek (f,i-1);
            write(f, r2, r1);
            b:=true;
           end;
       end;
    until b=false;
    end;
   
   if (n=0) or ( n=2) then
   begin
   repeat
     b:=false;
      for i:=1 to filesize(f)-1 do
       begin
        seek (f,i-1);
        read (f, r1,r2);
         if r1.num>r2.num then
           begin
            seek (f,i-1);
            write(f, r2, r1);
            b:=true;
           end;
       end;
    until b=false;
    end;
   
    if (n=0) or ( n=3) then
   begin
   repeat
     b:=false;
      for i:=1 to filesize(f)-1 do
       begin
        seek (f,i-1);
        read (f, r1,r2);
         if r1.mat>r2.mat then
           begin
            seek (f,i-1);
            write(f, r2, r1);
            b:=true;
           end;
       end;
    until b=false;
    end;
   
    if (n=0) or ( n=4) then
   begin
   repeat
     b:=false;
      for i:=1 to filesize(f)-1 do
       begin
        seek (f,i-1);
        read (f, r1,r2);
         if r1.fiz>r2.fiz then
           begin
            seek (f,i-1);
            write(f, r2, r1);
            b:=true;
           end;
       end;
    until b=false;
    end;
   
    if (n=0) or ( n=5) then
   begin
   repeat
     b:=false;
      for i:=1 to filesize(f)-1 do
       begin
        seek (f,i-1);
        read (f, r1,r2);
         if r1.rus>r2.rus then
           begin
            seek (f,i-1);
            write(f, r2, r1);
            b:=true;
           end;
       end;
    until b=false;
    end;
 
    close(f);
 end;
 Procedure TextRecord;
var t:text; 
    r: TSt;
begin 
Assign (t,'e:\file');
 rewrite(t);
 reset(f);
 while not eof(f)do
    begin
    read(f,r);
   
    writeln (r.Name:20, '      ', G(r.num,15),(r.mat:15),(r.fiz:15),G(r.rus,5));
    end;
 close(t);
 writeln('Данные успешно выгружены');
end; 
 
Procedure PieChart; 
var a: array of record name: string; k: integer; end;
   r: TSt;
    i,n,xc,yc,rad,x1,y1,x2,y2: integer;
    b: boolean;
     a1,a2,a0:integer;
begin
  reset(f);
 n:=0;
  while not eof(f)do
    begin
    read(f,r);
    b:=false;
  for i:=0 to length(a)-1 do
   if a[i].name=r.fiz then
     begin
      b:=true;
      a[i].k:=a[i].k+1;
     end;
    if b=false then
      begin
         SetLength(a,length(a)+1);
         a[n].name:=r.fiz;
         a[n].k:=1;
         n:=n+1;
      end;
     end;
 
   for i:=0 to length(a)-1 do writeln(i:3, ' ',a[i].name:13,a[i].k:4);
 
a1:=0;
xc:=400;
yc:=200;
rad:=100;
 for i:=0 to length(a)-1 do
    begin
       a0:=trunc (a[i].k*360 /filesize(f)) ;
     a2:=a1+a0;
     
     Pie(xc,yc,rad,a1,a2);
     x1:=xc+trunc((rad-10)*cos((a1+a0/2)*pi/180));
     y1:=yc-trunc((rad-10)*sin((a1+a0/2)*pi/180));
     x2:=xc+trunc((rad+30)*cos((a1+a0/2)*pi/180));
     y2:=yc-trunc((rad+30)*sin((a1+a0/2)*pi/180));
       Line(x1,y1,x2,y2);
   if (a1+a0/2 > 90) and (a1+a0/2 <270) then
     begin
        DrawTextCentered(x2-127, y2-20, x2,y2,a[i].name ); DrawTextCentered(x2-70, y2-20, x2,y2,'('); DrawTextCentered(x2-40, y2-20, x2,y2,a[i].k/filesize(f)*100 );DrawTextCentered(x2, y2-20, x2,y2,'%)')
        end
     else    
     begin
        DrawTextCentered(x2-47, y2-20, x2+100, y2,a[i].name); DrawTextCentered(x2+11, y2-20, x2+100, y2,'(');DrawTextCentered(x2+37, y2-20, x2+100, y2,a[i].k/filesize(f)*100 );DrawTextCentered(x2+78, y2-20, x2+100, y2,'%)')
        end;
     a1:=a2;
     if i=length(a)-1 then a2:=360;
   end;
close(f);
SetBrushColor(clWhite);
end;
begin
Assign (f,'e:\file');
repeat  
 {writeln('1 - иницилизация масива записей');
  writeln('2 - вывести таблицу');}
 writeln('1 - создать файл');
 writeln('2 - вывести файл');
 writeln('3 - добавить запись');
 writeln('4 - изменить запись');
 writeln('5 - удалить запись');
 writeln('6 - Отсортировать запись');
 writeln('7 - Выгрузка в текстовый файл');
 writeln('8 - Создание круговой диаграммы');
 writeln('0 - Выход');
readln(c);
case  c of  
   1: CreateFile;
   2: OutFile;
   3: AddRecord;
   4: EditRecord;
   5: DeltRecord;
   6: SortRecord;
   7: TextRecord;
   8: PieChart;
end; 
until c=0;end.

Последний раз редактировалось Pina; 06.06.2018 в 15:11.
Pina вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите пожалуйста дописать программу Катя08 Общие вопросы C/C++ 0 21.02.2016 22:30
Помогите в Паскале написать программу, пожалуйста. Saaashka Помощь студентам 5 20.04.2010 19:02
Помогите, пожалуйста, дописать программу на C++ (построение эквивалентной логической функции) Anastasiya209 Помощь студентам 0 07.06.2009 23:58
Помогите пожалуйста дописать программу Xan Помощь студентам 5 16.02.2009 09:18