I'd like to make a shape jump when the player presses the UP key, so the best i could think of is this, but the method i used is terrible and problematic:
(shape coordinates: shape1.top:=432;)
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case key of
vk_up: shape1.top:=shape1.top-40 //so that it jumps to 392
end;
end;
And now this timer:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer1.interval:=300
if shape1.Top<400 then //if shape1.top=392 < 400
begin
shape1.Top:=432; //move back to 432
end;
end;
The problem is that players can constantly press the key UP, which I don't want. I know this method is terrible, so i hope you have something better than this and i would be grateful if you could share it with me.
If the player can hold down a key and KeyDown fires repeatedly, you can lock it.
First, declare a field on the form called FKeyLock: set of byte
. (Note: this technique will fail if you get any Key
values higher than 255, but the ones you're likely to deal with won't be that high.)
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key in FKeyLock then
Exit;
case key of
vk_up:
begin
shape1.top:=shape1.top-40; //so that it jumps to 392
include(FKeyLock, vk_up);
end;
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
exclude(FKeyLock, key);
end;
Here's a ball bouncing in a constant force field (e.g., the field of gravity close to the surface of the Earth). The lateral walls and the floor are bouncing surfaces. You can add additional forces using the arrow keys:
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TRealVect = record
X, Y: real;
end;
const
ZeroVect: TRealVect = (X: 0; Y: 0);
type
TForm5 = class(TForm)
Timer1: TTimer;
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
function ACC: TRealVect;
const
RADIUS = 16;
DAMPING = 0.8;
DT = 0.2;
GRAVITY: TRealVect = (X: 0; Y: 10);
var
FForce: TRealVect;
FPos: TRealVect;
FVel: TRealVect;
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
function RealVect(X, Y: real): TRealVect;
begin
result.X := X;
result.Y := Y;
end;
function Add(A, B: TRealVect): TRealVect;
begin
result.X := A.X + B.X;
result.Y := A.Y + B.Y;
end;
function Scale(A: TRealVect; C: real): TRealVect;
begin
result.X := C*A.X;
result.Y := C*A.Y;
end;
function TForm5.ACC: TRealVect;
begin
result := Add(GRAVITY, FForce);
end;
procedure TForm5.FormCreate(Sender: TObject);
begin
FPos := RealVect(Width div 2, 10);
FVel := RealVect(0, 0);
end;
procedure TForm5.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_UP:
FForce := RealVect(0, -20);
VK_DOWN:
FForce := RealVect(0, 10);
VK_RIGHT:
FForce := RealVect(10, 0);
VK_LEFT:
FForce := RealVect(-10, 0);
end;
end;
procedure TForm5.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
FForce := ZeroVect;
end;
procedure TForm5.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color := clRed;
Canvas.Ellipse(round(FPos.X - RADIUS), round(FPos.Y - RADIUS),
round(FPos.X + RADIUS), round(FPos.Y + RADIUS));
end;
procedure TForm5.Timer1Timer(Sender: TObject);
begin
FVel := Add(FVel, Scale(ACC, DT));
FPos := Add(FPos, Scale(FVel, DT));
if FPos.Y + RADIUS >= ClientHeight then
begin
FVel.Y := -DAMPING*FVel.Y;
FPos.Y := ClientHeight - RADIUS - 1;
end;
if FPos.X - RADIUS <= 0 then
begin
FVel.X := -DAMPING*FVel.X;
FPos.X := RADIUS + 1;
end;
if FPos.X + RADIUS >= ClientWidth then
begin
FVel.X := -DAMPING*FVel.X;
FPos.X := ClientWidth - RADIUS - 1;
end;
Invalidate;
end;
end.
Set the timer's interval to 30
, as 'usual'.
来源:https://stackoverflow.com/questions/16445668/delphi7-make-a-shape-jump-when-pressing-up-key