unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, uplaysound, LclType, LclIntf;
type
{ TForm1 }
TForm1 = class(TForm)
lblRestart: TLabel;
field: TImage;
lblGameOver: TLabel;
lblScore: TLabel;
playsound1: Tplaysound;
Racket: TShape;
Ball: TShape;
tmrGame: TTimer;
procedure FormCreate(Sender: TObject);
procedure lblRestartClick(Sender: TObject);
procedure lblRestartMouseEnter(Sender: TObject);
procedure lblRestartMouseLeave(Sender: TObject);
procedure tmrGameTimer(Sender: TObject);
private
procedure initGame;
procedure updateScore;
procedure gameOver;
procedure increaseSpeed;
public
end;
type
TDirection = (dirLeft, dirRight, dirNone);
var
Form1: TForm1;
score: integer;
speedX, speedY: integer;
step: byte = 8;
Direction: TDirection = dirNone;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
Randomize;
initGame;
end;
procedure TForm1.lblRestartClick(Sender: TObject);
begin
initGame;
end;
procedure TForm1.lblRestartMouseEnter(Sender: TObject);
begin
lblRestart.Font.Style := [fsBold, fsUnderline];
end;
procedure TForm1.lblRestartMouseLeave(Sender: TObject);
begin
lblRestart.Font.Style := [];
end;
procedure TForm1.initGame;
var
startPos: integer;
begin
score := 0;
speedX := -4;
speedY := -4;
startPos := ClientWidth div 2 + Random(2 * 200) - 200;
Racket.Left := startPos - Racket.Width div 2;
Racket.Top := ClientHeight - Racket.Height - 2;
Ball.Left := startPos - Ball.Width div 2;
Ball.Top := Racket.Top - Ball.Height - 2;
lblGameOver.Visible := False;
lblRestart.Visible := False;
lblRestart.Font.Style := [];
updateScore;
Cursor := crNone;
field.Cursor := crNone;
tmrGame.Enabled := True;
end;
procedure TForm1.updateScore;
begin
lblScore.Caption := IntToStr(score);
end;
procedure TForm1.increaseSpeed;
begin
if speedX > 0 then
Inc(speedX)
else
Dec(speedX);
if speedY > 0 then
Inc(speedY)
else
Dec(speedY);
end;
procedure TForm1.gameOver;
begin
tmrGame.Enabled := False;
lblGameOver.Visible := True;
lblRestart.Visible := True;
Cursor := crDefault;
field.Cursor := crDefault;
end;
procedure TForm1.tmrGameTimer(Sender: TObject);
begin
if GetKeyState(VK_LSHIFT) < 0 then
Direction := dirLeft;
if GetKeyState(VK_RSHIFT) < 0 then
Direction := dirRight;
case Direction of
dirLeft: if Racket.Left >= step then
Racket.Left := Racket.Left - step;
dirRight: if Racket.Left + Racket.Width <= ClientWidth - step then
Racket.Left := Racket.Left + step;
end;
Direction := dirNone;
Ball.Left := Ball.Left + speedX;
Ball.Top := Ball.Top + speedY;
//Walls
if Ball.Top <= 0 then
begin
playsound1.SoundFile := 'wall1.wav';
playsound1.Execute;
speedY := -speedY;
end;
if (Ball.Left <= 0) or (Ball.Left + Ball.Width >= ClientWidth) then
begin
playsound1.SoundFile := 'wall1.wav';
playsound1.Execute;
speedX := -speedX;
end;
//Game over
if Ball.Top + Ball.Height > Racket.Top + Racket.Height div 2 then
begin
playsound1.SoundFile := 'gameover2.wav';
playsound1.Execute;
gameOver;
end;
//Good hit
if (Ball.Left + Ball.Width > Racket.Left) and (Ball.Left < Racket.Left + Racket.Width) and (Ball.Top + Ball.Height >= Racket.Top) then
begin
playsound1.SoundFile := 'hit.wav';
playsound1.Execute;
speedY := -speedY;
increaseSpeed;
Inc(score);
updateScore;
end;
end;
end.