Delphi7, make a shape jump when pressing Up key

允我心安 提交于 2019-11-29 23:59:10

问题


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.


回答1:


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;



回答2:


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'.

Compiled sample EXE



来源:https://stackoverflow.com/questions/16445668/delphi7-make-a-shape-jump-when-pressing-up-key

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!