unit PlayGround;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
LMessages, LCLType, LCLIntf, ExtCtrls, StdCtrls;
type
{ TPictureControl }
TPictureControl = class(TCustomControl)
procedure PictureChanged(Sender: TObject);
private
FPicture: TPicture;
procedure SetPicture(const AValue: TPicture);
procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
protected
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
property Picture: TPicture read FPicture write SetPicture;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnKeyDown;
property OnKeyUp;
property OnKeyPress;
end;
{ TPlayGroundForm }
TPlayGroundForm = class(TForm)
ComboBox1: TComboBox;
Label1: TLabel;
Panel1: TPanel;
Panel2: TPanel;
Timer1: TTimer;
procedure ComboBox1Change(Sender: TObject);
procedure PlayGroundFormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure PlayGroundFormCreate(Sender: TObject);
procedure PlayGroundFormDestroy(Sender: TObject);
procedure PictureControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
private
FXIntertia: Double;
FYIntertia: Double;
FSpritePos: TPoint;
FSpritePosChange: TPoint;
FSpritePosInit: Boolean;
procedure UpdateImage;
public
PictureControl: TPictureControl;
SpriteImg: TCustomBitmap;
BackgroundImg: TCustomBitmap;
BufferImg: TCustomBitmap;
end;
var
PlayGroundForm: TPlayGroundForm;
implementation
{$R playground.lfm}
uses
Math;
{ TPlayGroundForm }
procedure TPlayGroundForm.PlayGroundFormCreate(Sender: TObject);
begin
PictureControl:=TPictureControl.Create(Self);
with PictureControl do begin
Parent:=Panel1; //Self;
Align:=alClient;
OnKeyDown := @PictureControlKeyDown;
end;
SpriteImg:=TPortableNetworkGraphic.Create;
BackgroundImg:=TPortableNetworkGraphic.Create;
BufferImg:=TBitmap.Create;
SpriteImg.LoadFromFile(SetDirSeparators('../../images/ide_icon48x48.png'));
BackgroundImg.LoadFromFile(SetDirSeparators('../../images/splash_logo.png'));
BufferImg.Width:=BackgroundImg.Width;
BufferImg.Height:=BackgroundImg.Height;
FXIntertia := 0;
FYIntertia := 0;
Timer1.Enabled := Combobox1.ItemIndex = 0;
UpdateImage;
end;
procedure TPlayGroundForm.PlayGroundFormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
Timer1.Enabled:=false;
end;
procedure TPlayGroundForm.PlayGroundFormDestroy(Sender: TObject);
begin
SpriteImg.Free;
BackgroundImg.Free;
BufferImg.Free;
end;
procedure TPlayGroundForm.Timer1Timer(Sender: TObject);
begin
if csDestroying in ComponentState then exit;
UpdateImage;
end;
procedure TPlayGroundForm.ComboBox1Change(Sender: TObject);
begin
Timer1.Enabled := Combobox1.ItemIndex in [0, 2, 3, 4];
PictureControl.SetFocus;
end;
procedure TPlayGroundForm.PictureControlKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
const
DELTA = 20;
begin
if ComboBox1.ItemIndex = 3 then Exit; // for smooth arrow key input
case Key of
VK_LEFT : FSpritePosChange := Point(-DELTA, 0);
VK_RIGHT : FSpritePosChange := Point( DELTA, 0);
VK_UP : FSpritePosChange := Point(0, -DELTA);
VK_DOWN : FSpritePosChange := Point(0, DELTA);
end;
UpdateImage;
end;
function AdjustStep(p1, p2: Integer; Divisor: Integer): Integer;
var
f: Double;
delta: Integer;
begin
if p1 = p2 then
exit(0);
delta := p2 - p1;
f := delta/Divisor;
if abs(f) < 1 then
Result := sign(f)
else
Result := round(f);
{
Result
if Delta > 0 then begin
if Delta < Divisor then
Result := 1
else
Result := Delta div Divisor;
end else
if Delta < 0 then begin
if -Delta < Divisor then
Result := -1
else
Result := Delta div Divisor;
end else
Result := 0;
}
end;
procedure TPlayGroundForm.UpdateImage;
const
SECONDS_PER_DAY = 24*60*60;
var
DestImg: TBitmap;
t: Double;
CenterX: Integer;
CenterY: Integer;
dx, dy: Integer;
MousePos: TPoint;
begin
// paint first on the buffer
// paint background
BufferImg.Canvas.CopyRect(Rect(0,0,BufferImg.Width,BufferImg.Height),
BackgroundImg.Canvas,Rect(0,0,BackgroundImg.Width,BackgroundImg.Height));
// paint sprite
CenterX:=BufferImg.Width div 2;
CenterY:=BufferImg.Height div 2;
if not FSpritePosInit then begin
// SpritePos refers to the top/left corner of the sprite image.
FSpritePos := Point(CenterX - SpriteImg.Width div 2, CenterY - SpriteImg.Height div 2);
FSpritePosInit := true;
end;
case Combobox1.ItemIndex of
0: begin
// Movement of sprite by code along a calculated curve
t := Now * SECONDS_PER_DAY;
FSpritePos.X := CenterX + round(cos(t)*CenterX*2/3) - SpriteImg.Width div 2;
FSpritePos.Y := CenterY + round(sin(t*0.7)*CenterY*2/3) - SpriteImg.Height div 2;
end;
1: begin
// Movement of sprite by keyboard: UP/DOWN/LEFT/RIGHT arrows advance
// the sprite position by a given amount
FSpritePos.X := FSpritePos.X + FSpritePosChange.X;
FSpritePos.Y := FSpritePos.Y + FSpritePosChange.Y;
end;
2: begin
// Movement of sprite by mouse: the sprite follows the mouse
// Convert screen coordinates to images coordinates
MousePos := PictureControl.ScreenToClient(Mouse.CursorPos);
MousePos.X := round(MousePos.X / PictureControl.Width * PictureControl.Picture.Width);
MousePos.Y := round(MousePos.Y / PictureControl.Height * PictureControl.Picture.Height);
dx := AdjustStep(FSpritePos.X, MousePos.X, 5);
dy := AdjustStep(FSpritePos.Y, MousePos.Y, 5);
FSpritePos.X := FSpritePos.X + dx;
FSpritePos.Y := FSpritePos.Y + dy;
end;
3: begin
// Movement of sprite by keyboard: UP/DOWN/LEFT/RIGHT arrows advance smooth version
if (GetKeyState(VK_LEFT) < 0) then FSpritePos.X := FSpritePos.X - 10;
if (GetKeyState(VK_RIGHT) < 0) then FSpritePos.X := FSpritePos.X + 10;
if (GetKeyState(VK_UP) < 0) then FSpritePos.Y := FSpritePos.Y - 10;
if (GetKeyState(VK_DOWN) < 0) then FSpritePos.Y := FSpritePos.Y + 10;
end;
4: begin
// Movement of sprite by keyboard: UP/DOWN/LEFT/RIGHT arrows advance with inertia
if (GetKeyState(VK_LEFT) < 0) then FXIntertia := FXIntertia - 0.5;
if (GetKeyState(VK_RIGHT) < 0) then FXIntertia := FXIntertia + 0.5;
if (GetKeyState(VK_UP) < 0) then FYIntertia := FYIntertia - 0.5;
if (GetKeyState(VK_DOWN) < 0) then FYIntertia := FYIntertia + 0.5;
if (FXIntertia > 6) then FXIntertia := 6;
if (FXIntertia < -6) then FXIntertia := -6;
if (FYIntertia > 6) then FYIntertia := 6;
if (FYIntertia < -6) then FYIntertia := -6;
if (FXIntertia > 0) then FXIntertia := FXIntertia - 0.2;
if (FXIntertia < 0) then FXIntertia := FXIntertia + 0.2;
if (FYIntertia > 0) then FYIntertia := FYIntertia - 0.2;
if (FYIntertia < 0) then FYIntertia := FYIntertia + 0.2;
FSpritePos.X := FSpritePos.X + round(FXIntertia);
FSpritePos.Y := FSpritePos.Y + round(FYIntertia);
end;
end;
// Make sure that the sprite does not leave the image.
FSpritePos.X := EnsureRange(FSpritePos.X, 0, BufferImg.Width - SpriteImg.Width);
FSpritePos.Y := EnsureRange(FSpritePos.Y, 0, BufferImg.Height - SpriteImg.Height);
// Draw sprite at current position to buffer.
BufferImg.Canvas.Draw(FSpritePos.X, FSpritePos.Y, SpriteImg);
// copy to image
DestImg:=PictureControl.Picture.Bitmap;
DestImg.Width:=BufferImg.Width;
DestImg.Height:=BufferImg.Height;
DestImg.Canvas.Draw(0,0,BufferImg);
end;
{ TPictureControl }
procedure TPictureControl.SetPicture(const AValue: TPicture);
begin
if FPicture=AValue then exit;
FPicture.Assign(AValue);
end;
procedure TPictureControl.WMEraseBkgnd(var Msg: TLMessage);
begin
Msg.Result := 1;
end;
procedure TPictureControl.PictureChanged(Sender: TObject);
begin
Invalidate;
end;
constructor TPictureControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FPicture:=TPicture.Create;
FPicture.OnChange:=@PictureChanged;
end;
destructor TPictureControl.Destroy;
begin
FreeAndNil(FPicture);
inherited Destroy;
end;
procedure TPictureControl.Paint;
begin
if Picture.Graphic<>nil then
// Canvas.Draw(0,0,Picture.Graphic); // copy is fast
Canvas.StretchDraw(Rect(0,0,Width,Height),Picture.Graphic); // stretch is slow
inherited Paint;
end;
end.
WIKI Timeout issues
