Umiestnenie súboru www.TrSek.com/pas/bar_graph.pas

{ BAR_GRAPH.PAS                                                     }
{ Nahodne generovany bargraf urceny pre pouzitie v programe.        }
{ V premenej count je pocet stlpcov, v poli value jednotlive hodnoty}
{                                                                   }
{ Date  : 05.01.2009                           http://www.trsek.com }

program bar_graph;
uses crt, graph;
const MAX_COUNT=30;

var
    grDriver: Integer;
    grMode: Integer;

    value:array[1..MAX_COUNT] of integer;
    count:integer;
    i,x,y:integer;
    height: real;
    stepx: integer;
    stepy: real;
    max: integer;

procedure OpenGraph;
var
  ErrCode: Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
  ErrCode := GraphResult;

  if (ErrCode <> grOk) then begin
    Writeln('Error ', GraphErrorMsg(ErrCode));
    halt(1);
  end;

end;

function MakeAxis(x1,x2:integer; y1,y2:integer):real;
var maxx,maxy: integer;
    step: real;
begin
  maxx:=GetMaxX;
  maxy:=GetMaxY;

  line(1, maxy div 2, maxx, maxy div 2);
  line(20, 1, 20, maxy);

  step:=((maxy-20)/2)/(y2-y1);
  MakeAxis:=step;
end;

function ToStr(i:integer):string;
var s:string;
begin
  Str(i,s);
  ToStr:=s;
end;

begin
  { defautl value }
  write('Count (max=30) = ');
  readln(count);

  randomize;
  for i:=1 to count do
    value[i]:=random(100);

  { for test
  count:=5;
  value[1]:=81;
  value[2]:=14;
  value[3]:=91;
  value[4]:=38;
  value[5]:=72;
  }

  { found maximum }
  max:=value[1];
  for i:=1 to count do
    if( max<value[i] )then
        max:=value[i];

  OpenGraph;
  stepy:=MakeAxis(0, count, 0, max);
  stepx:=(GetMaxX-40) div count;
  setfillstyle(XHatchFill, Red);

  { put bar }
  for i:=1 to count do begin
    bar3d(20+((i-1)*stepx), (GetMaxY div 2),
          20+(    i*stepx), (GetMaxY div 2) - round(stepy*value[i]),
          0, TopOn);

    Outtextxy(20+((i-1)*stepx)+(stepx div 2), GetMaxY div 2+20,
              ToStr(value[i]));
  end;

  Readln;
  CloseGraph;
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com