Программа

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=100;
        X=200;
        Y=100;
        Xt=480;
        Yt=32;
  Var Sum:real;
      I,J:integer;
      Angle,Angle2:word;
      Buf,Buf2:string[4];
      Ra,Ra2:real;
  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;
    Angle2:=0;
    for I:=1 to KY do
      begin
        Angle:=Angle2;
        Ra2:=0;
        for J:=1 to I do

            Ra2:=Ra2+ASD[J].SunDayP*360;
            Angle2:=Trunc(Ra2);

        SetFillStyle(I+1,I+1);
        PieSlice(X,Y,Angle,Angle2,R);
        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.