Программа

program Lab_3_graph_1;
Uses Crt,Graph;
Const KYm=12;
      Xm=620;
      Ym=200;
      NameF='abcdefgh.ijk';
Type YSDF=record
            Year:integer;
            SunDay:0..366
          end;
     YSDA=array[1..KYm] of record
                            Year:integer;
                            SunDayP:real
                          end;
Var ArraySunDay:YSDA;
    Flag:boolean;
    Otv:char;
    DriverVar,ModeVar:integer;
    KY:byte;
procedure D;
  Begin
    Delay(50)
  End;
procedure DD;
  Begin
    Delay(0500)
  End;
procedure DDD;
  Begin
    Delay(1500)
  End;
procedure MakerFileYSD(Var KY:byte);
  Var F:file of YSDF;
      Buf:YSDF;
      I:integer;
      Otv:char;
  Begin
    repeat
      KY:=Random(10)+2; {        KY:=12;  }
      ClrScr;
      writeln('SCVORTCOV_SOFT'); writeln;                                  d;
      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);                                d;
          write(F,Buf)
        end;
      Close(F);
      writeln;
{      writeln('Изменить ? (Y)');
 }   until {not (ReadKey in ['Y','y'])} true
  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 s;
  begin
    MoveTo(33*8,1*8);
    SetTextStyle((Random(5)+3) mod 5,0,1);
    OutText('SKVORTSOV-SOFT');
    SetTextStyle(0,0,1);
  end;
procedure Dekart;
 Var I:byte;
     Buf:string[3];
  Begin                        s;                                        d;
    SetLineStyle(0,0,1);
    Rectangle(0,0,638,199);
    SetTextStyle(0,0,1);
    OutTextXY(12,4,'%');                                                 d;
    OutTextXY(2,16,'100');                                               d;
    MoveTo(32,20);
    LineRel(0,4);                                                        d;
    LineRel(-8,0);                                                       d;
    MoveRel(8,0);
    for I:=10 downto 1 do
      begin
        LineRel(0,16);                                                   d;
        Str((I-1)*10,Buf);
        LineRel(-8,0);                                                   d;
        MoveRel(-20,-8);
        OutText(Buf);                                                    d;
        MoveRel(12,8)
      end;
    LineRel(480,0);                                                      d;
  End;
procedure Gr(ASD:YSDA;KY:byte);
  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(Random(4),0,Random(2)*2+1);

    Dekart;                                                              dd;
    X1:=32;
    if KY>1 then dX:=440 div (KY-1)
            else dX:=440;
    X2:=488;
    Y2:=16;
    Y1:=184;
    for I:=0 to KY-1 do
      begin
        X:=X1+dX*I;
        Line(X,Y1,X,Y1+4);                                                d;
        Str(ASD[I+1].Year,Buf);
        OutTextXY(X-16,Y1+6,Buf);                                         d;
        OutTextXY(X2,Y2+I*8,Buf);                                          d;
      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));   d;
    X2:=536;
    Y2:=16;
    for I:=1 to KY do
      begin
        MoveTo(X2,Y2);
        Str(Trunc(ASD[I].SunDayP*100),Buf);
        OutText(Buf+'%');                                                 d;
        Y2:=Y2+8;
      end
  End;
procedure Kist(ASD:YSDA;KY:byte);
  Var L:0..620;
      X,X1,X2,dX:0..620;
      Y,Y1,Y2,dY:0..200;
      I:byte;
      Buf:string[4];
  Begin
    ClearDevice;
{    SetColor(Random(15)+1);   }
    SetColor(3);
    SetLineStyle(0,0,1);
    SetTextStyle(0,0,1);
    SetFillStyle(Random(10)+2,Random(15)+1);
    Dekart;                                                              dd;
    X1:=32;
    if KY>0 then dX:=440 div KY
            else dX:=440;
    X2:=488;
    Y2:=16;
    Y1:=184;
    if KY=0 then Bar(X,Y1,x+8,y1+4);                                      d;
    for I:=0 to KY-1 do
      begin
        X:=X1+dX*I;
        Line(X,Y1,X,Y1+4);                                                d;
        Str(ASD[I+1].Year,Buf);
        OutTextXY(X+8,Y1+6,Buf);                                          d;
        OutTextXY(X2,Y2+I*8,Buf);                                         d;
      end;
    MoveTo(X1,Y1-Trunc(ASD[1].SunDayP*160));
    SetLineStyle(0,0,1);
    for I:=2 to KY+1 do Bar3D(X1+dX*(I-2)+4,Y1-Trunc(ASD[I-1].SunDayP*160),X1+dX*(I-1)-4,Y1,14,true);
d;    X2:=536;
    Y2:=16;
    for I:=1 to KY do
      begin
        MoveTo(X2,Y2);
        Str(Trunc(ASD[I].SunDayP*100),Buf);
        OutText(Buf+'%');                                                 d;
        Y2:=Y2+8;
      end
  End;
procedure SectDiag(ASD:YSDA;KY:byte);
  Const R=110;
        X=200;
        Y=100;
        Xt=480;
        Yt=4;
       Z=-12;
  Var Sum,Ra,Ra2:real;
      I,J:integer;
      Angle,Angle2:word;
      Buf,Buf2:string[4];
  Begin
    ClearDevice;                 s;                                  dd;
    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);                                    dd;
        Angle:=Angle+Trunc(ASD[I].SunDayP*360);
        Str(ASD[I].Year,Buf);
        Str(Trunc(ASD[I].SunDayP*1000),Buf2);
        OutTextXY(Xt,Yt+I*16+Z,Buf+':       0.'+Buf2);                   dd;
        Bar(Xt+48,Yt+I*16-4+Z,Xt+48+32,Yt+I*16+8+Z);                      d;
      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']   }  true then MakerFileYSD(KY);             ddd;
    FileToASD(ArraySunDay,Flag);
if {Flag} true then Begin
                   ClrScr;
                   DriverVar:=Detect;
                   InitGraph(DriverVar,ModeVar,'C:\TP7');
                   Gr(ArraySunDay,KY);                                   ddd;
{                   Otv:=ReadKey;
 }                  Kist(ArraySunDay,KY);                                ddd;
{                   Otv:=ReadKey;
 }                  SectDiag(ArraySunDay,KY);                       ddd; ddd;
{                   Otv:=ReadKey;
 }                  CloseGraph
                 End
            else Begin
                   writeln(' ошибка чтения файла ');
                   Otv:=ReadKey
                 End
  until false
END.