Uses Graph;

const
  n = 10;
  amount = n;

(* Draws the gistogram of the given sequence on the screen *)
Procedure DrawGistogram(place: Integer;
          arr: Array of Integer; Color: Integer);
  Var
    i, size_x, Top: Integer;
    left, right: integer;
    start, range:
      Record
        x, y: Integer;
      End;
    s: string;

    numGeneral: integer;
  Begin
    Start.X := 1;
    Start.Y := GetMaxY - 20;

    SetColor(White);
    SetBkColor(Black);
    Range.X := GetMaxX div 2;
    Range.Y := GetMaxY div 2;

    numGeneral := 0;
    for i := 0 to pred(amount) do
      inc(numGeneral, arr[i]);

    Line(Start.X, Start.Y, Start.X, Start.Y);

    size_x := Range.X div amount;
    SetFillStyle(SolidFill, Color);
    For i := 0 To Pred(amount) Do
      Begin
        left := Start.X + i * size_x;
        right := left + size_x;
        top := Start.Y - Trunc( Range.Y * arr[i] / NumGeneral );
        bar3d(left + 1, top + 1, right - 1, Start.Y - 1, 15, true);

        str(arr[i], s);
        outtextxy( left, Start.Y + 3, s );
      End;
  End;

var
  Temp, i, j: integer;
  flag: boolean;

const
  x: array[1 .. n] of integer =
    (2, 6, 12, 8, 4, 9, 5, 10, 11, 3);

var
  grDriver: Integer;
  grMode: Integer;
  ErrCode: Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
  ErrCode := GraphResult;
  if ErrCode <> grOk then
    begin
      writeln('error: ', grapherrormsg(errcode));
      readln; halt(100)
    end;

  repeat
    DrawGistogram(0, x, Blue); ReadLn;
    ClearDevice;

    flag:=true;
    for i:=1 to n-1 do
      if x[i]>0 then
        for j:=i+1 to n do
          if (x[j]>0)and(x[j]<x[i]) then begin
            temp:=x[i];
            x[i]:=x[j];
            x[j]:=temp;
            flag:=false;
          end;
    DrawGistogram(0, x, Red); ReadLn;
    ClearDevice;
  until flag;
  closegraph;
end.