Delphi7, make a shape jump when pressing Up key

房东的猫 提交于 2019-11-30 16:44:46

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

Compiled sample EXE

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