Листинг файла Basketball.Pas :
Unit Basketball;
interface
uses
Graphics;
type
TGElement = class (TObject)
private
Canvas: TCanvas;
x: Word;
y: Word;
public
constructor Create(ACanvas: TCanvas);
procedure Draw; virtual;
procedure Erase; virtual;
function GetX: Word; virtual;
function GetY: Word; virtual;
procedure MoveTo(AX: word; AY: word); virtual;
end;
TPlayer = class (TGElement)
private
Height: byte;
public
constructor Create(ACanvas: TCanvas);
procedure SetHeight(AHeight: byte);
procedure Draw; override;
procedure Erase; override;
end;
TBall = class (TGElement)
constructor Create(ACanvas: TCanvas);
procedure Draw; override;
procedure Erase; override;
end;
TBasket = class (TGElement)
constructor Create(ACanvas: TCanvas);
procedure Draw; override;
procedure Erase; override;
end;
TBoard = class (TGElement)
constructor Create(ACanvas: TCanvas);
procedure Draw; override;
procedure Erase; override;
end;
implementation
{
********************************** TGElement ***********************************
}
constructor TGElement.Create(ACanvas: TCanvas);
begin
x:= 0;
y:= 0;
Canvas:= ACanvas;
end;
procedure TGElement.Draw;
begin
end;
procedure TGElement.Erase;
begin
end;
function TGElement.GetX: Word;
begin
result:= x;
end;
function TGElement.GetY: Word;
begin
result:= y;
end;
procedure TGElement.MoveTo(AX: word; AY: word);
begin
Erase;
x:= AX;
y:= AY;
Draw;
end;
{
*********************************** TPlayer ************************************
}
constructor TPlayer.Create(ACanvas: TCanvas);
begin
x:= 0;
y:= 0;
Canvas:= ACanvas;
Height:= 0;
end;
procedure TPlayer.SetHeight(AHeight: byte);
begin
Height:= AHeight;
end;
procedure TPlayer.Draw;
begin
With Canvas do
begin
Lock;
Pen.Color:= clblack;
Brush.Color:= clwhite;
MoveTo(x, y);
Ellipse(x+1, y, x+27, y+23);
Ellipse(x+17, y+6, x+20, y+9);
MoveTo(x+23, y+18);
LineTo(x+17, y+15);
Ellipse(x, y+23, x+28, y+86);
MoveTo(x+14, y+40);
LineTo(x+37, y+11);
LineTo(x+41, y+11);
LineTo(x+42, y+12);
LineTo(x+42, y+18);
LineTo(x+18, y+48);
MoveTo(x+27, y+41);
LineTo(x+49, y+15);
LineTo(x+49, y+10);
LineTo(x+48, y+9);
LineTo(x+45, y+9);
LineTo(x+42, y+12);
Rectangle(x+6, y+82, x+23, y+148+2*(Height));
MoveTo(x+18, y+82);
LineTo(x+18, y+148+2*(Height));
MoveTo(x+6, y+148+2*(Height));
LineTo(x+6, y+151+2*(Height));
LineTo(x+22, y+151+2*(Height));
LineTo(x+18, y+147+2*(Height));
Rectangle(x+6, y+150+2*(Height), x+26, y+153+2*(Height));
MoveTo(x+23, y+148+2*(Height));
LineTo(x+26, y+151+2*(Height));
MoveTo(x+21, y+151+2*(Height));
LineTo(x+21, y+153+2*(Height));
Pen.Color:= clwhite;
Rectangle(x+22, y+31, x+26, y+39);
Pen.Color:= clblack;
Unlock;
end;
end;
procedure TPlayer.Erase;
begin
With Canvas do
begin
Lock;
Pen.Color:= clwhite;
Brush.Color:= clwhite;
MoveTo(x, y);
Ellipse(x+1, y, x+27, y+23);
Ellipse(x+17, y+6, x+20, y+9);
MoveTo(x+23, y+18);
LineTo(x+17, y+15);
Ellipse(x, y+23, x+28, y+86);
MoveTo(x+14, y+40);
LineTo(x+37, y+11);
LineTo(x+41, y+11);
LineTo(x+42, y+12);
LineTo(x+42, y+18);
LineTo(x+18, y+48);
MoveTo(x+27, y+41);
LineTo(x+49, y+15);
LineTo(x+49, y+10);
LineTo(x+48, y+9);
LineTo(x+45, y+9);
LineTo(x+42, y+12);
Rectangle(x+6, y+82, x+23, y+148+2*(Height));
MoveTo(x+18, y+82);
LineTo(x+18, y+148+2*(Height));
MoveTo(x+6, y+148+2*(Height));
LineTo(x+6, y+151+2*(Height));
LineTo(x+22, y+151+2*(Height));
LineTo(x+18, y+147+2*(Height));
Rectangle(x+6, y+150+2*(Height), x+26, y+153+2*(Height));
MoveTo(x+23, y+148+2*(Height));
LineTo(x+26, y+151+2*(Height));
MoveTo(x+21, y+151+2*(Height));
LineTo(x+21, y+153+2*(Height));
Pen.Color:= clwhite;
Rectangle(x+22, y+31, x+26, y+39);
Pen.Color:= clblack;
Unlock;
end;
end;
{
************************************ TBall *************************************
}
constructor TBall.Create(ACanvas: TCanvas);
begin
x:= 0;
y:= 0;
Canvas:= ACanvas;
end;
procedure TBall.Draw;
begin
With Canvas do
begin
Lock;
Pen.Color:= clblack;
Brush.Color:= clred;
MoveTo(x, y);
Ellipse(x, y, x+25, y+25);
Brush.Color:= clwhite;
Unlock;
end;
end;
procedure TBall.Erase;
begin
With Canvas do
begin
Lock;
Pen.Color:= clwhite;
Brush.Color:= clwhite;
MoveTo(x, y);
Ellipse(x, y, x+25, y+25);
Unlock;
end;
end;
{
*********************************** TBasket ************************************
}
constructor TBasket.Create(ACanvas: TCanvas);
begin
x:= 0;
y:= 0;
Canvas:= ACanvas;
end;
procedure TBasket.Draw;
begin
With Canvas do
begin
Lock;
Pen.Color:= clblack;
Brush.Color:= clwhite;
MoveTo(x, y);
Rectangle(x, y, x+50, y+5);
MoveTo(x+50, y+2);
LineTo(x+55, y+2);
Unlock;
end;
end;
procedure TBasket.Erase;
begin
With Canvas do
begin
Lock;
Pen.Color:= clwhite;
Brush.Color:= clwhite;
MoveTo(x, y);
Rectangle(x, y, x+50, y+5);
MoveTo(x+50, y+2);
LineTo(x+55, y+2);
Unlock;
end;
end;
{
************************************ TBoard ************************************
}
constructor TBoard.Create(ACanvas: TCanvas);
begin
x:= 0;
y:= 0;
Canvas:= ACanvas;
end;
procedure TBoard.Draw;
begin
With Canvas do
begin
Lock;
Pen.Color:= clblack;
Brush.Color:= clwhite;
MoveTo(x, y);
Rectangle(x, y, x+5, y+100);
MoveTo(x+5, y+25);
LineTo(x+15, y+25);
MoveTo(x+5, y+75);
LineTo(x+15, y+75);
Rectangle(x+15, y+25, x+25, y+300);
Unlock;
end;
end;
procedure TBoard.Erase;
begin
With Canvas do
begin
Lock;
Pen.Color:= clwhite;
Brush.Color:= clwhite;
MoveTo(x, y);
Rectangle(x, y, x+5, y+100);
MoveTo(x+5, y+25);
LineTo(x+30, y+25);
MoveTo(x+5, y+75);
LineTo(x+30, y+75);
Rectangle(x+15, y+25, x+25, y+300);
Unlock;
end;
end;
end.