Programs using CRT and Wingraph

CRT_Demo

program CRT_Demo;
  {$APPTYPE CONSOLE}
uses
   crt in 'crt.pas';
const
  Colours : array[0 .. 7] of string = ('Black', 'Blue', 'Green', 'Cyan',
                                 'Red', 'Magenta',  'Brown',  'LightGray');
var
  Count, Colour : integer ;
  MaxX, Width, Height, XLeft, XRight, YTop, YBottom : integer;
  InputChar : char;
  Response : string;

procedure ColouredWindow (X1, Y1, X2, Y2, Colour : integer);
begin
  //Colour the window
  window(X1, Y1 , X2, Y2);
  textBackground(Colour);
  clrScr;
  //Write window's colour half way down
  textColor(LightGreen);
  goToXY(1, Height DIV 2);
  write(Colours[Colour]);
end;

begin 
  MaxX := screenWidth;
  //Draw a rectangle for each background colour.
  Width := MaxX DIV 8;
  //Same number of pixels vertically as horizontally
  Height := Width;
  for Count := 0 to 7 do
    begin
      XLeft :=  1 + Width * Count;
      XRight := XLeft + Width;
      YTop := 1;
      YBottom := Height + YTop;
      ColouredWindow(XLeft, YTop, XRight, YBottom, Count);
    end;
  ColouredWindow(1, Height + YTop, 1 + 7 * Width, 2 * Height + YTop, White);
  textColor(Yellow);
  setCursorType(_NOCURSOR);
  goToXY(1, 5);
  writeln('Press return to continue. ');
  InputChar := readKey;
  setCursorType(_NORMALCURSOR);
  textBackground(Black);
  window(1, 1, MaxX, YTop + 2 * Height);
  clrScr;
  normVideo;
  writeln('Normal text');
  highVideo;
  writeln('Highlighted text');
  normvideo;
  writeln('Text back to normal');
  write('Please type a character. ');
  InputChar := readKey;
  Response := 'Input character: ' + InputChar;
  //Output Response in middle of current window
  goToXY((MaxX - Length(Response)) DIV 2, screenWidth DIV 2 );
  writeln(Response);
  textColor(Yellow);
  write('Press return to exit. ');
  readln;
end.

ShowAxes

program ShowAxes;
  {$APPTYPE CONSOLE}
uses
  SysUtils,  WinGraph in 'wingraph.pas';
var
  Gd, Gm : smallint;
  Count, MaxX, MaxY : integer;
  strMark : string;
begin
  Gd := Detect;  //Set graphics driver to 0.
  Gm := 0;       //Graphics mode will be set automatically.
  InitGraph(Gd, Gm, ''); //Open the graph window
  MaxX := getMaxX;
  MaxY := getMaxY;
  // setTextStyle(ScriptFont, HorizDir, 1);
  //Put labelled marks every 100 pixels along the x axis.
  for Count := 1 to MaxX DIV 100 do
    begin
      line(Count * 100, 0, Count * 100, 20);
      strMark := 'x = ' + intToStr(Count * 100);
      moveTo(Count * 100 - textWidth(strMark), 25);
      outText(strMark);
    end;
  //Put labelled marks every 100 pixels along the y axis.
  for Count := 1 to MaxY DIV 100 do
    begin
      line(0, Count * 100, 20, Count * 100);
      strMark := 'y = ' + intToStr(Count * 100);
      moveTo(25, Count * 100 - textHeight(strMark) DIV 2);
      outText(strMark);
    end;
  repeat
    sleep(10);
  until CloseGraphRequest; //close icon clicked
  closeGraph;
  write('Please press return to exit. ');
  readln;
end.

Draw

program Draw;
  {$APPTYPE CONSOLE}
uses
  SysUtils, WinGraph in 'wingraph.pas';
const
  HB = 10;     //Horizontal border
  VB = 10;     //Vertical border
var
  Gd, Gm : smallint;
  MaxX, MaxY, Col1, Col2, Col3, Row1, Row2, Row3, CentreX, CentreY,
  Count, StartX, StartY, X, Y : integer;
  Pentagon : array[1 .. 6] of PointType;
  Triangle : array[1 .. 3] of PointType;
  Choice : char;

procedure DrawRow1;
begin
  //Red rectangle
  setColor(Red);
  rectangle(HB , VB, Col1 - HB, Row1 - VB);
  //Yellow filled rectangle
  setFillStyle(SolidFill, Yellow);
  bar(Col1 + HB, VB, Col2 - HB, Row1 - VB);
  //Green circle
  setColor(Green);
  CentreX :=  (Col3 + Col2) DIV 2;
  CentreY :=  Row1 DIV 2;
  circle(CentreX, CentreY, (Row1 DIV 2) - VB);
  //Blue filled ellipse
  setcolor(Blue);
  setFillStyle(SolidFill, Blue);
  CentreX := CentreX + Col1;
  fillEllipse(CentreX, CentreY, (Col1 DIV 2) - HB, (Row1 DIV 2) - VB);
end;

procedure DrawRow2;
begin
  //Cyan line (solid)
  setColor(Cyan);
  line (HB, Row1 + VB, Col1 - HB, Row2 - VB);
  //Brown dashed line
  SetLineStyle(DashedLn, 0, NormWidth);
  moveTo(Col1 + HB, Row2 - VB);
  setColor(Brown);
  lineTo(Col2 - HB, Row1 + VB);
  //white ellipse
  setColor(White);
  setLineStyle(SolidLn, 0, NormWidth);
  CentreX :=  (Col3 + Col2) DIV 2;
  CentreY :=  (Row2 + Row1) DIV 2;
  ellipse(CentreX, CentreY, 0, 360, (Col1 DIV 2) - HB, (Row1 DIV 2) - VB);
  //Burgundy filled circle
  setColor(Burgundy);
  setFillStyle(BkSlashFill, Burgundy);
  CentreX :=  (Col3 + MaxX) DIV 2;
  CentreY :=  (Row2 + Row1) DIV 2;
  fillEllipse(CentreX, CentreY, (Row1 DIV 2)- VB, (Row1 DIV 2)- VB);
end;

procedure DrawRow3;
begin
  //Three quarters of light cyan ellipse
  setColor(LightCyan);
  CentreX :=  Col1 DIV 2;
  CentreY :=  (Row2 + Row3) DIV 2;
  ellipse(CentreX, CentreY, 0, 270, (Col1 Div 2) - HB, (Row1 Div 2) - VB);
  //Indigo shaded rectangle
  setFillStyle(SolidFill, Indigo);
  setcolor(Indigo);
  bar3d(Col1 + HB, Row2 + VB, Col2 - HB, Row3 - VB, 10, True);
  //Light green pentagon
  setColor(Navy);
  Pentagon[1].x := (Col3 + Col2) DIV 2;  Pentagon[1].y := Row2 + VB;
  Pentagon[2].x :=  Col3 - HB;           Pentagon[2].y := (Row2 + Row3) DIV 2;
  Pentagon[3].x :=  Col3 - (Col1 DIV 3); Pentagon[3].y := Row3 - VB;
  Pentagon[4].x :=  Col2 + (Col1 DIV 3); Pentagon[4].y := Row3 - VB;
  Pentagon[5].x :=  Col2 +  HB;          Pentagon[5].y := (Row2 + Row3) DIV 2;
  Pentagon[6].x := Pentagon[1].x;        Pentagon[6].y := Pentagon[1].y;
  drawpoly(6, Pentagon);
  //Light red filled triangle
  setFillStyle(SolidFill, LightRed);
  setColor(LightRed);
  Triangle[1].x := (Col3 + MaxX) DIV 2;  Triangle[1].y :=  Row2 + VB;
  Triangle[2].x :=  MaxX - HB;           Triangle[2].y :=  Row3 - VB;
  Triangle[3].x :=  Col3 + HB;           Triangle[3].y :=  Row3 - VB;
  fillpoly(3, triangle);
end;

procedure DrawRow4;
begin
  //Teal sector of ellipse
  setColor(Teal);
  setFillStyle(SolidFill, Teal);
  CentreX :=  Col1 DIV 2;
  CentreY :=  (Row3 + MaxY) DIV 2;
  //270 degrees is direction of y axis and 360 degrees is angle of y axis
  sector(CentreX, CentreY, 270, 360, (Col1 DIV 2) - HB, (Row1 DIV 2) - VB);
  //Plot points for straight lines
  for Count := 1 to (Row1 DIV 2) - VB do
    begin
      putPixel(Col1 + HB + Count, Row3 + VB + Count, LightBlue);
    end;
  StartX := Col1 + HB + Count;
  StartY := Row3 + VB + Count;
  for Count := 1 to (Row1 DIV 2) - VB do
    begin
      putPixel(StartX + Count, StartY - Count, LightBlue);
    end;
  //Yellow text
  setColor(Yellow);
  setTextStyle(ArialFont, HorizDir, 16);
  moveTo(col1 + HB, (Row3 + MaxY) DIV 2);
  outText('www.pp4s.co.uk');
  //White curve
  Count := 1;
  X := Col2 + HB + (Count * 10);
  Y := Row3 + VB + (Count * Count) DIV 5;
  while (X <= Col3 - HB) and (Y <= MaxY - VB) do
    begin
      //Plot curve (4 pixels per point to make it more visible)
      putPixel(X, Y, Azure);
      putPixel(X - 1, Y, Azure);
      putPixel(X, Y - 1, Azure);
      putPixel(X - 1, Y - 1, Azure);
      inc(Count);
      X := Col2 + HB + (Count * 10);
      Y := Row3 + VB + (Count * Count) DIV 5;
    end;
  //Light green arc
  setColor(LightGreen);
  arc((col3 + MaxX) DIV 2, (Row3 + MaxY) DIV 2, 0, 180, (Row1 DIV 2) - VB);
end;

begin 
  write('When the graphics window opens, you may need to restore'+
        ' down or minimise'#13#10'the window then maximise it' +
        ' to see all of the shapes.'#13#10#13#10,'Type F for' +
        ' full size or Q for quarter size. ');
  repeat
    readln(Choice);
  until Choice in ['F', 'f', 'Q', 'q'];
  write('Press return to exit. ');
  Gd := Detect; 
  Gm := 0;
  InitGraph(Gd, Gm, '');

  if Choice in ['F', 'f'] then
    begin
      MaxX := GetMaxX;
      MaxY := GetMaxY;
    end
  else
    begin
      MaxX := GetMaxX DIV 2;
      MaxY := GetMaxY DIV 2;
    end;
  //Divide the area into columns and rows
  Col1 := MaxX DIV 4;  //End of column
  Col2 := MaxX DIV 2;
  Col3 := Col1 + Col2;
  Row1 := MaxY DIV 4;   //End of row
  Row2 := MaxY DIV 2;
  Row3 := Row1 + Row2;
  setLineStyle(Solidln, 0, Thickwidth);
  setColor(White);
  //Set background colour
  setBkColor(White);
  setFillStyle(SolidFill, LightGray);
  bar(0, 0, MaxX, MaxY);
  //Draw
  DrawRow1;
  DrawRow2;
  DrawRow3;
  DrawRow4;
  repeat
    sleep(10);
  until CloseGraphRequest; //close icon clicked
  CloseGraph;
  readln;
end.

Mandelbrot

The output from program Mandelbrot is very different using wingraph because numbers for colours refer to their RGB values. Program Mandelbrot2 uses an array of RGB values copied from wingraph to provide a more colourful image. We have adapted the code for use in applets using Oxygene for Java.

Output from program Mandelbrot

Output from program Mandelbrot

Output from program Mandelbrot2

Output from program Mandelbrot2

program Mandelbrot;
  {$APPTYPE CONSOLE}
  {Based on Merlin's Delphi Forge
  http://www.delphifaq.net/how-to-draw-a-mandelbrot-fractal-on-the-forms-canvas/}
uses
  SysUtils, wingraph in 'wingraph.pas';

procedure DrawMandelbrot;
var
  iNewColor, iMaxX, iMaxY  : integer;
  Gd, Gm, iI, iJ  : smallint;
  rU, rV, rX, rY, rZ : real;
begin
  Gd := Detect; //Graph driver becomes zero
  Gm := 0;      //Graph mode will be set automatically because Gd = 0;
  InitGraph(Gd, Gm, '');
  iMaxX := GetMaxX;
  iMaxY := GetMaxY;
    for iI := 0 to iMaxX - 2 do
      begin
        for iJ := 0 to iMaxY - 2 do
          begin
            //Centre and scale along real (x) axis 
            rX := -0.85 + 3 * iI / iMaxX;
            //Centre and scale along imaginary (y) axis
            rY := -1.2 + 2.4 * iJ / iMaxY;
            iNewColor := 0;
            rU := 0;
            rV := 0;
            repeat
              rZ := Sqr(rU) - Sqr(rV) - rX;
              rV := 2 * rU * rV - rY;
              rU := rZ;
              inc(iNewColor);
            until (Sqr(rU) + Sqr(rV) > 4) or (iNewColor = 1000);
            if iNewColor = 1000 then
              iNewColor := black;
            PutPixel(iI + 1, iJ + 1, iNewColor);
          end;
      end; 
end;

begin
  writeln('When the graphics window opens, you may need to restore down or' +
          ' minimise'#13#10'the window then maximise it ' +
          ' to see all of the graphic.'#13#10#13#10'Press return to continue.');
  readln;
  DrawMandelbrot;
  repeat
    sleep(10);
  until closeGraphRequest; //close icon clicked
  closeGraph;
  writeln('Press return to exit.');
  readln;
end.

Mandelbrot2

program Mandelbrot2;
  {$APPTYPE CONSOLE}
  {Based on Merlin's Delphi Forge
  http://www.delphifaq.net/how-to-draw-a-mandelbrot-fractal-on-the-forms-canvas/}
uses
  SysUtils, wingraph in 'wingraph.pas';
const
  DefaultVGAPalette: array[0..255] of longword =
      ($000000,$A80000,$00A800,$A8A800,$0000A8,$A800A8,$0054A8,$A8A8A8,
       $545454,$FC8484,$54FC54,$FCFC54,$5454FC,$FC54FC,$54FCFC,$FCFCFC,
       $000000,$141414,$202020,$2C2C2C,$383838,$444444,$505050,$606060,
       $707070,$808080,$909090,$A0A0A0,$B4B4B4,$C8C8C8,$E0E0E0,$FCFCFC,
       $FC0000,$FC0040,$FC007C,$FC00BC,$FC00FC,$BC00FC,$7C00FC,$4000FC,
       $0000FC,$0040FC,$007CFC,$00BCFC,$00FCFC,$00FCBC,$00FC7C,$00FC40,
       $00FC00,$40FC00,$7CFC00,$BCFC00,$FCFC00,$FCBC00,$FC7C00,$FC4000,
       $FC7C7C,$FC7C9C,$FC7CBC,$FC7CDC,$FC7CFC,$DC7CFC,$BC7CFC,$9C7CFC,
       $7C7CFC,$FC9CFC,$7CBCFC,$7CDCFC,$7CFCFC,$7CFCDC,$7CFCBC,$7CFC9C,
       $7CFC7C,$9CFC7C,$BCFC7C,$DCFC7C,$FCFC7C,$FCDC7C,$FCBC7C,$FC9C7C,
       $FCB4B4,$FCB4C4,$FCB4D8,$FCB4E8,$FCB4FC,$E8B4FC,$D8B4FC,$C4B4FC,
       $B4B4FC,$B4C4FC,$B4D8FC,$B4E8FC,$B4FCFC,$B4FCE8,$B4FCD8,$B4FCC4,
       $B4FCB4,$C4FCB4,$D8FCB4,$E8FCB4,$FCFCB4,$FCE8B4,$FCD8B4,$FCC4B4,
       $700000,$70001C,$700038,$700054,$700070,$540070,$380070,$1C0070,
       $000070,$001C70,$003870,$005470,$007070,$007054,$007038,$00701C,
       $007000,$1C7000,$387000,$547000,$707000,$705400,$703800,$701C00,
       $703838,$703844,$703854,$703860,$703870,$603870,$543870,$443870,
       $383870,$384470,$385470,$386070,$387070,$387060,$387054,$387044,
       $387038,$447038,$547038,$607038,$707038,$706038,$705438,$704438,
       $705050,$705058,$705060,$705068,$705070,$685070,$605070,$585070,
       $505070,$505870,$506070,$506870,$507070,$507068,$507060,$507058,
       $507050,$587050,$607050,$687050,$707050,$706850,$706050,$705850,
       $400000,$400010,$400020,$400030,$400040,$300040,$200040,$100040,
       $000040,$001040,$002040,$003040,$004040,$004030,$004020,$004010,
       $004000,$104000,$204000,$304000,$404000,$403000,$402000,$401000,
       $402020,$402028,$402030,$402038,$402040,$382040,$302040,$282040,
       $202040,$202840,$203040,$203840,$204040,$204038,$204030,$204028,
       $204020,$284020,$304020,$384020,$404020,$403820,$403020,$402820,
       $402C2C,$402C30,$402C34,$402C3C,$402C40,$3C2C40,$342C40,$302C40,
       $2C3040,$2C3440,$2C3C40,$2C4040,$2C403C,$2C4034,$2C4030,$2C402C,
       $30402C,$34402C,$3C402C,$40402C,$403C2C,$40342C,$40302C,$000000,
       $000000,$000000,$000000,$000000,$000000,$000000,$000000,$000000);

procedure DrawMandelbrot;
var
  iNewColor, iMaxX, iMaxY  : integer;
  Gd, Gm, iI, iJ  : smallint;
  rU, rV, rX, rY, rZ : real;
begin
  Gd := Detect; //Graph driver becomes zero
  Gm := 0;      //Graph mode will be set automatically because Gd = 0;
  InitGraph(Gd, Gm, '');
  iMaxX := GetMaxX;
  iMaxY := GetMaxY;
    for iI := 0 to iMaxX - 2 do
      begin
        for iJ := 0 to iMaxY - 2 do
          begin
            //Centre and scale along real (x) axis
            rX := -0.85 + 3 * iI / iMaxX;
            //Centre and scale along imaginary (y) axis
            rY := -1.2 + 2.4 * iJ / iMaxY;
            iNewColor := 0;
            rU := 0;
            rV := 0;
            repeat
              rZ := Sqr(rU) - Sqr(rV) - rX;
              rV := 2 * rU * rV - rY;
              rU := rZ;
              inc(iNewColor);
            until (Sqr(rU) + Sqr(rV) > 4) or (iNewColor = 1000);
            if iNewColor = 1000 then
              iNewColor := black;
            PutPixel(iI + 1, iJ + 1, DefaultVGAPalette[iNewColor]);
          end;
      end;
end;

begin
  writeln('When the graphics window opens, you may need to restore down or' +
          ' minimise'#13#10'the window then maximise it ' +
          ' to see all of the graphic.'#13#10#13#10'Press return to continue.');
  readln;
  DrawMandelbrot;
  repeat
    sleep(10);
  until closeGraphRequest; //close icon clicked
  closeGraph;
  writeln('Press return to exit.');
  readln;
end.

MoveLetter

program MoveLetter;
  {$APPTYPE CONSOLE}
uses
  SysUtils, crt in 'crt.pas';
const
  SLEEP_TIME = 25;
  HEIGHT = 24;
  CHARACTER = 'N';
var
  Width : integer;

procedure Diagonal;
var
  i : integer;
begin
  for i := 1 to HEIGHT do
    begin
      goToXY(i, i);
      write(CHARACTER);
      sleep(SLEEP_TIME);
      goToXY(i, i);
      write(' ');
    end;
end;

procedure Up (Column : integer);
var
  i : integer;
begin
  for i := HEIGHT downto 1 do
    begin
      goToXY(Column, i);
      write(CHARACTER);
      sleep(SLEEP_TIME);
      goToXY(Column, i);
      write(' ');
    end;
end;

begin
  Width := HEIGHT;
  setCursorType(_NOCURSOR);
  Up(1);
  Diagonal;
  Up(Width);
  //Replace the deleted letter in its final position 
  write(CHR(8), CHARACTER);
  setCursorType(_NORMALCURSOR);
  readln;
end.

Rebound

program Rebound;
  {$APPTYPE CONSOLE}
uses
  SysUtils, wingraph in 'wingraph.pas';
const
  SLEEP_TIME = 20;
  DIAMETER = 10;
  X_MOVE_DIST = 5;
  Y_MOVE_DIST = 5;
  X_MAX = 240;
  Y_MAX = 240;
  Y_START = 100;
var
  Gd, Gm : smallint;
  Error, X, Y, Radius, i : integer;
  PBall : pointer;
  MemoryBall : word;
  RightNext, DownNext : Boolean;

procedure Move;
begin
  //Calculate new X co-ordinate
  if RightNext then
    begin
      if X + Diameter >= X_MAX then
        begin
          RightNext := False;
          X := X - X_MOVE_DIST;
        end
      else
        begin
          X := X + X_MOVE_DIST;
        end;
    end
  else //Moving left
    begin
      if X <= 0 then
        begin
          RightNext := True;
          X := X + X_MOVE_DIST;
        end
      else
        begin
          X := X - X_MOVE_DIST;
        end;
    end;
  //Calculate new Y co-ordinate
  if DownNext then
    begin
      if Y + Diameter >= Y_MAX then
        begin
          DownNext := False;
          Y := Y - Y_MOVE_DIST;
        end
      else
        begin
          Y := Y + Y_MOVE_DIST;
        end;
    end
  else //Moving up
    begin
      if Y <= 0 then
        begin
          DownNext := True;
          Y := Y + Y_MOVE_DIST;
        end
      else
        begin
          Y := Y - Y_MOVE_DIST;
        end;
    end;
  //Draw the ball
  putImage(X, Y, PBall^, 0);
  //fillEllipse(X + Radius, Y + Radius, Radius, Radius); 
  sleep(SLEEP_TIME);
  //Delete the ball
  bar(X, Y, Diameter + X, Diameter + Y);
end;

begin
  //Open a 640 x 480 pixel, 16 colour graph window
  Gd := D4bit;
  Gm := m640x480;
  initGraph(Gd, Gm, '');
  //Check graphResult
  Error := graphResult;
  if (error <> grOk) then
    begin
      writeln('640 x 480 x 16 is not supported.');
      sleep(5000);
      halt;
    end;
  //Draw a white ball at the top left of the screen.
  setFillStyle(SolidFill, White);
  Radius := Diameter DIV 2;
  fillEllipse(Radius, Radius, Radius, Radius);
  //Find the memory required to hold it in a buffer
  MemoryBall := imageSize(0, 0, Diameter, Diameter);
  getMem(PBall, MemoryBall); //Reserve the buffer of size MemoryBall.
  getImage(0, 0, Diameter, Diameter, PBall^); //Copy image to buffer
  //Delete the ball, which was drawn there only to be copied.
  setFillStyle(SolidFill, Black);
  bar(0, 0, Diameter, Diameter);
  //Draw 2 sides of the container
  line(X_MAX + 1, 0, X_MAX + 1, Y_MAX + 1);
  line(0, Y_MAX + 1, X_MAX + 1, Y_MAX + 1);
  //Initialize
  X := 0;
  Y := Y_START;
  DownNext := True;
  RightNext := True;
  //Move the ball
  for i := 1 to 500 do
    begin
      Move;
    end;
  //Free the buffer
  freeMem(PBall, MemoryBall);
  closeGraph;
  write('Please press return to exit. ');
  readln;
end.

BouncingBall

program BouncingBall;
  {$APPTYPE CONSOLE}
uses
  SysUtils, wingraph in 'wingraph.pas';
const
  SLEEP_TIME = 20;
  DROP_TIME = 8;
  BOUNCES = 10;
  RADIUS = 10;
var
  Gd, Gm : smallint;
  Error, i, j,  X, Y, YStart : integer;
  PBall : pointer;
  MemoryBall : word;
begin
  Gd := D4bit;
  Gm := m640x480;
  initGraph(Gd, Gm, '');
  //Check graphResult
  Error := graphResult;
  if (error <> grOk) then
    begin
      writeln('640 x 480 x 16 is not supported.');
      sleep(5000);
      halt;
    end;
  //Draw a white ball at the top left of the screen.
  setFillStyle(SolidFill, White);
  fillEllipse(Radius, Radius, Radius, Radius);
  //Find the memory required to hold it in a buffer
  MemoryBall := imageSize(0, 0, Radius * 2, Radius * 2);
  getmem(PBall, MemoryBall); //Reserve the buffer of size MemoryBall
  getImage(0, 0, Radius * 2, Radius * 2, PBall^); //Copy image to buffer
  //Delete the ball, which was put there only to be copied.
  setFillStyle(SolidFill, Black);
  bar(0, 0, Radius * 2, Radius * 2);
  //Calculate suitable coordinates from which to drop the ball
  X := Radius + 50;
  YStart := getMaxY - (2 * Radius) - (DROP_TIME * DROP_TIME);
  for j := 1 to BOUNCES do
    begin
      //Accelerate the ball as it moves down
      for i := 0 to DROP_TIME do
        begin
          //Position the ball lower
          Y := i * i + YStart;
          putImage(X, Y, PBall^, 0);
          sleep(SLEEP_TIME);
          //Delete the ball
          bar(X, Y, Radius * 2 + X, Radius * 2 + Y);
        end;
      //Decelerate the ball as it moves up
      for i := DROP_TIME downto 0 do
        begin
          //Position the ball higher
          Y := i * i + YStart;
          putImage(X, Y, PBall^, 0);
          sleep(SLEEP_TIME);
          //Delete the ball
          bar(X, Y, Radius * 2 + X, Radius * 2 + Y);
        end;
    end;
  //One last drop
  for i := 0 to DROP_TIME do
    begin
      //Position the ball lower
      Y := i * i + YStart;
      putImage(X, Y, PBall^, 0);
      sleep(SLEEP_TIME);
      bar(X, Y, Radius * 2 + X, Radius * 2 + Y);
    end;
  //Position the ball to rest on the ground
  putImage(X, Y, PBall^, 0);
  //Free the buffer
  freeMem(PBall, MemoryBall);
  sleep(2000);
  closeGraph;
  write('Please press return to exit. ');
  readln;
end.    
Programming - a skill for life!

Graphics using the CRT, WinCrt and Wingraph units in Delphi