unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls,
Dialogs, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
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 = 30;
gravity = 2;
var
Form1: TForm1;
blocks: array of TRect;
px, py, vx, vy: integer;
upKey, leftKey, rightKey: boolean;
implementation
uses Math;
{$R *.lfm}
procedure GenerateBlocks;
var
i: integer;
width: integer;
begin
Randomize;
SetLength(blocks, 10);
for i := 0 to length(blocks)-1 do begin
width := Random(200) + 100;
blocks[i].Left := Random(Form1.ClientWidth - width);
blocks[i].Right := blocks[i].Left + width;
blocks[i].Top := Random(Form1.ClientHeight - 10 - Form1.Image1.Height) + Form1.Image1.Height;
blocks[i].Bottom := blocks[i].Top + 10;
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
if upKey then vy := -jump else vy := 0;
Refresh;
exit;
end;
end;
py := py + 1;
end;
end else begin
py := py + vy;
end;
Refresh;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_UP then upKey := true;
if Key = VK_LEFT then leftKey := true;
if Key = VK_RIGHT then rightKey := true;
if Key = VK_SPACE then GenerateBlocks;
if Key = VK_ESCAPE then FormCreate(nil);
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_UP then upKey := false;
if Key = VK_LEFT then leftKey := false;
if Key = VK_RIGHT then rightKey := false;
end;
end.