AgreeX Game Pack

Dette er ikke et direkte spørgsmål, men som i kan se er den nedenstående kode fra 1999 og jeg er aldrig kommet videre, så derfor ønsker jeg gode kommentarer, forslag og indput.

Planen var/er at lave en Game Pack der er uafhængig af DirectX og GPL (eller hvad det nu hedder) - idag burde det betyde den også kan bruges til Linux Games hvis man bruger Kylix - men det har jeg ikke pt. så det må tiden vise.

De 30 point blive delt ud til de bedste indput.


unit AgreeX;

{ Delphi AgreeX Game Pack - Copyright Agree Data }
{ Version 1.0 - Beta code 001 - july 13, 1999 }

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

const

  FxW = 480;
  FxH = 320;

type

  TAgreeX = class(TGraphicControl)
  private
    Parent: TForm;
    FBackGround: TBitmap;
    FWork: TBitmap;
    FOnIdle: TIdleEvent;
    FDelay: integer;
    FRunning: boolean;
    Update: integer;
    FOnEscapeKey: TKeyEvent;
    FOnSpaceBar: TKeyEvent;
    FOnLeftKey: TKeyEvent;
    FOnRightKey: TKeyEvent;
    FOnDownKey: TKeyEvent;
    FOnUpKey: TKeyEvent;
    OldKeyEvent: TKeyEvent;
    DoOldKeyEvent: Boolean;
    procedure WMSize(var message: TWMSize); message WM_Paint;
  protected
    procedure Loaded; override;
    procedure Paint; override;
    procedure Loop(Sender: TObject; var Done: Boolean);
    procedure SetBackGround(Value: TBitmap);
    procedure KeyHandler(Sender: TObject; var Key: word; Shift: TShiftState);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
    property BackGround: TBitmap read FBackGround write SetBackGround;
    property Delay: integer read FDelay write FDelay default 10;
    property Running: boolean read FRunning write FRunning default False;
    property OnEscapeKey: TKeyEvent read FOnEscapeKey write FOnEscapeKey;
    property OnSpaceBar: TKeyEvent read FOnSpaceBar write FOnSpaceBar;
    property OnLeftKey: TKeyEvent read FOnLeftKey write FOnLeftKey;
    property OnRightKey: TKeyEvent read FOnRightKey write FOnRightKey;
    property OnDownKey: TKeyEvent read FOnDownKey write FOnDownKey;
    property OnUpKey: TKeyEvent read FOnUpKey write FOnUpKey;
  end;

  TSprite = class(TGraphicControl)
  private
    FSprite : TBitmap;
  protected
    procedure SetSprite(Value: TBitmap);
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;
  published
    property Sprite: TBitmap read FSprite write SetSprite;
  end;


procedure Register;

implementation

var AgreeInstance: integer = 0;
    AgreeWorkCanvas: TCanvas;

constructor TAgreeX.Create(AOwner: TComponent);
begin
  Inc(AgreeInstance);
  if AgreeInstance > 1 then
  begin
    ShowMessage('Only one instance of AgreeX');
    Abort;
  end;
  inherited Create(AOwner);
  Parent := TForm(AOwner);
  Width  := FxW;
  Height := FxH;
  FBackGround := TBitmap.Create;
  FBackGround.Width := FxW;
  FBackGround.Height := FxH;
  FWork := TBitmap.Create;
  FWork.Width := FxW;
  FWork.Height := FxH;
  FDelay := 10;
  FRunning := False;
  Update := 0;
  DoOldKeyEvent := False;
  AgreeWorkCanvas := Canvas;
end;

procedure TAgreeX.WMSize(var message: TWMSize);
begin
  inherited;
  Width  := FxW;
  Height := FxH;
end;

procedure TAgreeX.Loaded;
begin
  if Assigned(Parent.OnKeyDown) then
  begin
    OldKeyEvent := Parent.OnKeyDown;
    DoOldKeyEvent := True;
  end;
  Parent.OnKeyDown := KeyHandler;
  Application.OnIdle := Loop;
end;

procedure TAgreeX.KeyHandler(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  case Key of
    vk_Escape : if Assigned(FOnEscapeKey) then FOnEscapeKey(Sender, Key, Shift);
    vk_Space : if Assigned(FOnSpaceBar) then FOnSpaceBar(Sender, Key, Shift);
    vk_Left : if Assigned(FOnLeftKey) then FOnLeftKey(Sender, Key, Shift);
    vk_Right : if Assigned(FOnRightKey) then FOnRightKey(Sender, Key, Shift);
    vk_Down : if Assigned(FOnDownKey) then FOnDownKey(Sender, Key, Shift);
    vk_Up : if Assigned(FOnUpKey) then FOnUpKey(Sender, Key, Shift);
  end;
  if DoOldKeyEvent then OldKeyEvent(Sender, Key, Shift);
end;

procedure TAgreeX.Loop(Sender: TObject; var Done: Boolean);
var xtest, ytest: integer;
begin
  { Begin }
  if Running then
  begin
    { Game Loop Code }
    Inc(Update);
    if FDelay = Update then
    begin
      Update := 0;
      Paint;
    end;
    { Test code - }
    xtest := Random(FxW);
    ytest := Random(FxH);
    FWork.Canvas.Rectangle(xtest, ytest, xtest + 25, ytest + 25);
    { - Remove before release }
  {End}
  end;
  if Assigned(FOnIdle) then FOnIdle(Sender, Done);
  Done := False; { Done set to false for max speed }
end;

procedure TAgreeX.Paint;
begin
  Canvas.Draw(0, 0, FWork);
  FWork.Canvas.Draw(0, 0, FBackGround);
end;

procedure TAgreeX.SetBackGround(Value: TBitmap);
begin
  FWork.Assign(Value);
  FBackGround.Canvas.StretchDraw(Rect(0, 0, FxW, FxH), FWork);
  FWork.Width := FxW;
  FWork.Height := FxH;
  Paint;
  Paint; { Needed - but why ? }
end;

destructor TAgreeX.Destroy;
var
  I: Integer;
  Temp: TComponent;
begin
  Application.OnIdle := Nil;
  FWork.Free;
  FBackGround.Free;
  Dec(AgreeInstance);
  inherited Destroy;
  If AgreeInstance = 0 then
  begin
    for I := Parent.ComponentCount - 1 downto 0 do
    begin
      Temp := Parent.Components[I];
      if (Temp is TSprite) then Parent.RemoveComponent(Temp);
    end;
  end;
end;

constructor TSprite.Create(AOwner: TComponent);
begin
  if AgreeInstance = 0 then
  begin
    ShowMessage('Need one instance of AgreeX');
    Abort;
  end;
  inherited Create(AOwner);
  FSprite := TBitmap.Create;
end;

procedure TSprite.SetSprite(Value: TBitmap);
begin
  FSprite.Assign(Value);
  Width  := FSprite.Width;
  Height := FSprite.Height;
  Paint;
end;

procedure TSprite.Paint;
begin
  AgreeWorkCanvas.Draw(Left, Top, FSprite);
end;

destructor TSprite.Destroy;
begin
  FSprite.Free;
  inherited Destroy;
end;


procedure Register;
begin
  RegisterComponents('Agree', [TAgreeX, TSprite]);
end;

end.