unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
const
speed = 10;
jump = 40;
gravity = 2;
var
Form1: TForm1;
blocks: array of TRect;
px, py, vx, vy: integer;
leftKey, rightKey: boolean;
score, maxScore: integer;
implementation
uses Math;
{$R *.lfm}
procedure GenerateBlock(i: integer; top: integer);
var
width: integer;
begin
width := Random(Form1.ClientWidth div 6) + Form1.ClientWidth div 6;
blocks[i].Left := Random(Form1.ClientWidth - width);
blocks[i].Right := blocks[i].Left + width;
blocks[i].Top := top;
blocks[i].Bottom := blocks[i].Top + 10;
end;
procedure GenerateBlocks;
var
i: integer;
begin
Randomize;
SetLength(blocks, 10);
for i := 0 to length(blocks)-1 do begin
GenerateBlock(i, Random(Form1.ClientHeight));
end;
end;
procedure ScrollBlocks(dy: integer);
var
i: integer;
begin
if dy = 0 then exit;
score := score + dy;
if score > maxScore then maxScore := score;
py := py + dy;
for i := 0 to length(blocks)-1 do begin
blocks[i].Top := blocks[i].Top + dy;
blocks[i].Bottom := blocks[i].Bottom + dy;
if blocks[i].Top < 0 then begin
GenerateBlock(i, Form1.ClientHeight + Random(abs(dy)));
end else
if blocks[i].Top > Form1.ClientHeight then begin
GenerateBlock(i, -10 - Random(abs(dy)));
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GenerateBlocks;
px := (blocks[0].Left + blocks[0].Right) div 2;
py := blocks[0].Top;
vx := 0; vy := 0;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i: integer;
begin
Canvas.Brush.Color := clBlack;
for i := 0 to length(blocks)-1 do begin
Canvas.FillRect(blocks[i]);
end;
Canvas.Draw(px - Image1.Picture.Bitmap.Width div 2,
py - Image1.Picture.Bitmap.Height,
Image1.Picture.Bitmap);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i, j: integer;
begin
vy := vy + gravity;
if leftKey then px := px - speed;
if rightKey then px := px + speed;
if vy > 0 then begin
for j := 0 to vy-1 do begin
for i := 0 to length(blocks)-1 do begin
if (py = blocks[i].Top) and (px > blocks[i].Left) and (px < blocks[i].Right) then begin
vy := -jump;
break;
end;
end;
if vy <= 0 then break;
py := py + 1;
end;
end else begin
py := py + vy;
end;
ScrollBlocks(ClientHeight div 2 - py);
Label1.Caption := 'Score: ' + IntToStr(score);
Label2.Caption := 'Max score: ' + IntToStr(maxScore);
Label1.Refresh;
Label2.Refresh;
Refresh;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_LEFT then leftKey := true;
if Key = VK_RIGHT then rightKey := true;
if Key = VK_SPACE then GenerateBlocks;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_LEFT then leftKey := false;
if Key = VK_RIGHT then rightKey := false;
end;
end.