Новичок
Джуниор
Регистрация: 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.
|