Uses Graph, CRT;
Type Group=Record
            Name:String;
            Marks:ARRAY[2..5] of Byte;
           End;
var
 Gr:Array[1..25] of Group;
 Mmed:Array[1..25] of Real;
 N:Byte;
 S:String;
 i,j:Integer;
 Sum1,Sum2:Real;
 Width, BarWidth, BarHight,X:WORD;
begin
 Write('Enter number of groups (<26) ');
 ReadLn(N);
 For i:=1 to N do
  With Gr[i] do
   begin
    WriteLn('Group name (max 8 symbols; only Latin letters and figures!):');
    ReadLn(Name);
    For j:=2 to 5 do
     begin
      Write('Number of "',j,'" marks ');
      ReadLn(Marks[j]);
     end;
    WriteLn;
   end;
 For i:=1 to N do
  begin
   Sum1:=0;
   Sum2:=0;
   With Gr[i] do
    For j:=2 to 5 do
     begin
      Sum1:=Sum1+Marks[j]*j;
      Sum2:=Sum2+Marks[j];
     end;
   Mmed[i]:=Sum1/Sum2;
  end;

 InitGraph( ){Здесь Вам нужно задать параметры процедуры самостоятельно, под Ваш компьютер};
 ClearDevice;
 SetColor(Cyan);
 SetLineStyle(SolidLn,0,ThickWidth);
 Rectangle(30, 10, 640, 410);
 SetLineStyle(SolidLn,0,NormWidth);
 SetTextStyle(DefaultFont, HorizDir,1);
 SetTextJustify(RightText, CenterText);
 OutTextXY(26, 10, '100');
 OutTextXY(26, 410, '0');
 For i:=1 to 9 do
  begin
   Str(i*10,S);
   OutTextXY(26, 410-i*40, S);
   Line(30,410-i*40,640,410-i*40);
  end;
 Width:=600 div N;
 BarWidth:=Width-10;
 SetTextStyle(DefaultFont, VertDir,1);
 SetTextJustify(CenterText, TopText);
 For i:=1 to N do
  begin
   OutTextXY(30+(i-1)*Width+10+(BarWidth div 2), 414, Gr[i].Name);
   Line(30+(i-1)*Width+10+(BarWidth div 2), 410,
                 30+(i-1)*Width+10+(BarWidth div 2), 10);
  end;
 SetFillStyle(SolidFill,Red);
 For i:=1 to N do
  begin
   X:=30+(i-1)*Width+10+(BarWidth div 2);
   BarHight:=ROUND(400/5*Mmed[i]);
   Bar(X-(BarWidth div 2),409, X+(BarWidth div 2), 411-BarHight);
  end;
 ReadKey;
 CloseGraph;
end.