Программа
program Lab_3_graph_1;
Uses Crt,Graph;
Const KY=5;
Xm=620;
Ym=200;
NameF='abcdefgh.ijk';
Type YSDF=record
Year:integer;
SunDay:0..366
end;
YSDA=array[1..KY] of record
Year:integer;
SunDayP:real
end;
Var ArraySunDay:YSDA;
Flag:boolean;
Otv:char;
DriverVar,ModeVar:integer;
procedure MakerFileYSD;
Var F:file of YSDF;
Buf:YSDF;
I:integer;
Otv:char;
Begin
repeat
ClrScr;
Assign(F,NameF);
rewrite(F);
for I:=1994-KY to 1993 do
begin
Buf.Year:=I;
if (I mod 4)=0 then Buf.SunDay:=Random(367)
else Buf.SunDay:=Random(366);
writeln(Buf.Year,' ',Buf.SunDay);
write(F,Buf)
end;
Close(F);
writeln;
writeln('Изменить ? (Y)');
until not (ReadKey in ['Y','y'])
End;
procedure FileToASD(Var ASD:YSDA;Var FlagV:boolean);
Var I:byte;
F:file of YSDF;
Buf:YSDF;
Begin
ASD[KY].Year:=0;
Assign(F,NameF);
Reset(F);
I:=0;
While (not eof(F)) and (I<KY) do
begin
I:=I+1;
read(F,Buf);
ASD[I].Year:=Buf.Year;
if (Buf.Year mod 4)=0 then ASD[I].SunDayP:=Buf.SunDay/366
else ASD[I].SunDayP:=Buf.SunDay/365;
end;
Close(F);
FlagV:=ASD[KY].Year<>0
End;
procedure Dekart;
Var I:byte;
Buf:string[3];
Begin
Rectangle(0,0,638,199);
MoveTo(32,20);
LineRel(0,4);
LineRel(-8,0);
MoveRel(8,0);
for I:=10 downto 1 do
begin
LineRel(0,16);
Str((I-1)*10,Buf);
LineRel(-8,0);
MoveRel(-20,-8);
OutText(Buf);
MoveRel(12,8)
end;
LineRel(480,0);
OutTextXY(3,16,'100');
OutTextXY(12,4,'%')
End;
procedure Gr(ASD:YSDA);
Var L:0..620;
X,X1,X2,dX:0..620;
Y,Y1,Y2,dY:0..200;
I:byte;
Buf:string[4];
Begin
ClearDevice;
SetColor(15);
SetLineStyle(0,0,1);
SetTextStyle(0,0,1);
Dekart;
X1:=32;
dX:=440 div (KY-1);
X2:=488;
Y2:=16;
Y1:=184;
for I:=0 to KY-1 do
begin
X:=X1+dX*I;
Line(X,Y1,X,Y1+4);
Str(ASD[I+1].Year,Buf);
OutTextXY(X-16,Y1+6,Buf);
OutTextXY(X2,Y2+I*8,Buf)
end;
MoveTo(X1,Y1-Trunc(ASD[1].SunDayP*160));
SetLineStyle(1,0,3);
for I:=2 to KY do LineTo(X1+dX*(I-1),Y1-Trunc(ASD[I].SunDayP*160));
X2:=536;
Y2:=16;
for I:=1 to KY do
begin
MoveTo(X2,Y2);
Str(Trunc(ASD[I].SunDayP*100),Buf);
OutText(Buf+'%');
Y2:=Y2+8;
end
End;
procedure Kist(ASD:YSDA);
Var L:0..620;
X,X1,X2,dX:0..620;
Y,Y1,Y2,dY:0..200;
I:byte;
Buf:string[4];
Begin
ClearDevice;
SetColor(15);
SetLineStyle(0,0,1);
SetTextStyle(0,0,1);
Dekart;
X1:=32;
dX:=440 div KY;
X2:=488;
Y2:=16;
Y1:=184;
for I:=0 to KY-1 do
begin
X:=X1+dX*I;
Line(X,Y1,X,Y1+4);
Str(ASD[I+1].Year,Buf);
OutTextXY(X+8,Y1+6,Buf);
OutTextXY(X2,Y2+I*8,Buf)
end;
MoveTo(X1,Y1-Trunc(ASD[1].SunDayP*160));
SetLineStyle(1,0,3);
for I:=2 to KY+1 do Bar(X1+dX*(I-2)+2,Y1-Trunc(ASD[I-1].SunDayP*160),X1+dX*(I-1)-2,Y1);
X2:=536;
Y2:=16;
for I:=1 to KY do
begin
MoveTo(X2,Y2);
Str(Trunc(ASD[I].SunDayP*100),Buf);
OutText(Buf+'%');
Y2:=Y2+8;
end
End;
procedure SectDiag(ASD:YSDA);
Const R=180;
X=200;
Y=100;
Xt=480;
Yt=32;
Var Sum:real;
I:integer;
Angle:word;
Buf,Buf2:string[4];
Begin
ClearDevice;
SetLineStyle(0,0,1);
SetTextStyle(0,0,1);
Rectangle(0,0,638,199);
Sum:=0;
for I:=1 to KY do
begin
Sum:=Sum+ASD[I].SunDayP
end;
for I:=1 to KY do
begin
ASD[I].SunDayP:=ASD[I].SunDayP/Sum
end;
Angle:=0;
for I:=1 to KY do
begin
SetFillStyle(I+1,I+1);
PieSlice(X,Y,Angle,Angle+Trunc(ASD[I].SunDayP*360),R);
Angle:=Angle+Trunc(ASD[I].SunDayP*360);
Str(ASD[I].Year,Buf);
Str(Trunc(ASD[I].SunDayP*1000),Buf2);
OutTextXY(Xt,Yt+I*24,Buf+': 0.'+Buf2);
Bar(Xt+48,Yt+I*24-4,Xt+48+32,Yt+I*24+8)
end
End;
BEGIN
repeat
ClrScr;
write('Создать новый файл?(Y/N) ');
repeat
Otv:=ReadKey
until Otv in ['Y','N','y','n'];
writeln(Otv);
if Otv in ['Y','y'] then MakerFileYSD;
FileToASD(ArraySunDay,Flag);
if Flag then Begin
ClrScr;
DriverVar:=Detect;
InitGraph(DriverVar,ModeVar,'D:\TP\GRAPH');
Gr(ArraySunDay);
Otv:=ReadKey;
Kist(ArraySunDay);
Otv:=ReadKey;
SectDiag(ArraySunDay);
Otv:=ReadKey;
CloseGraph
End
else Begin
writeln(' ошибка чтения файла ');
Otv:=ReadKey
End
until Ord(Otv)=27
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию