unit moving;
(*
  Esimerkki
   1) TImageListin käytöstä
   2) TPaintBoxin perimisestä
   3) TBitMapin käytöstä (mm. peilaaminen y-akselin suhteen)
   4) Viestin lähettämisestä (Event) omistajalle
       - auto lähettää aina liikahtaessaan viestin
       - auto lähettään viestin kun se kääntyy

   Vesa Lappalainen 23.10.1997

   Changed  : 5.11.1999/vl
    + peritty TSpritestä
   Changed  : 14.11.1999/vl
    + korjattu React-metodia
    + korjattu PaintTo-metodia siten, etta suunta päätetään suunnasta, ei dx:stä
    + lisätty MovingReact perittäväksi paremmin
   Changed  : 08.09.2001/vl
    + VCL/CLX-käännös
    + entinen TAuto muutettu TMovingSprite ja TAuto peritään TMovingSprite
    + direction changed to double and the unis is now degrees in math coordinate
*)

interface

uses
  SysUtils, Classes, Types,
{$ifdef CLX}
  QGraphics, QControls, QForms, QDialogs, QExtCtrls,
  QImgList,
{$else}
  Windows, Messages, Graphics, Controls, Forms, Dialogs,  ExtCtrls,
{$endif}
  sprite;

type
  TMovingSprite = class;

  TOnSpriteMove  = procedure (sender:TMovingSprite) of object;
  TOnChangeDir = procedure (sender:TObject;dir:integer) of object;

  TMovingSprite = class(TSprite)
  private
    FSpeed : double;
    FDirection : integer; // allways -180 - 180
    dx,dy   : double;
    FOnMove : TOnSpriteMove;
    FOnChangeDir : TOnChangeDir;
    FStayOnParentArea: boolean;
    procedure CountDirection;
  protected
    FBitName : String;
    FImageList : TImageList;
    procedure CountDXDY; virtual;
  public
    constructor Create(AOwner:TComponent); override;
    destructor  Destroy; override;
    procedure SetBitName(s:string); virtual;
    procedure SetSpeed(d:double); virtual;
    procedure SetDirection(i:integer); virtual;
    function DoJob:boolean; override;
    function PaintTo(canvas:TCanvas):boolean; override;
    function React(sprite:TSprite):boolean; override;
    function MovingReact(sprite:TSprite):boolean; virtual;
  published
    property BitName : string read FBitName write SetBitName;
    property Speed : double read FSpeed write SetSpeed;
    property Direction : integer read FDirection write SetDirection default 0;
    property OnMove : TOnSpriteMove read FOnMove write FOnMove;
    property OnChangeDir : TOnChangeDir read FOnChangeDir write FOnChangeDir;
    property StayOnParentArea : boolean read FStayOnParentArea write FStayOnParentArea default true;
  end;


implementation

uses Math;

constructor TMovingSprite.Create(AOwner:TComponent);
begin
  inherited;
  FImageList := TImageList.Create(self);
  FSpeed := 0;
  FDirection := 0;
  CountDXDY;
  FOnMove := NIL;
  FOnChangeDir := NIL;
  FStayOnParentArea := true;
end;

destructor TMovingSprite.Destroy;
begin
  FImageList.Free;
  inherited;
end;


procedure TMovingSprite.CountDXDY();
var rad : double;
begin
  rad := Direction * Pi / 180;
  dx := cos(rad);
  dy := sin(rad);
end;

procedure TMovingSprite.CountDirection();
var rad : double;
begin
  if ( dx = 0 ) then begin
    if ( dy < 0 ) then Direction := -90 else Direction := 90;
    exit;
  end;
  rad := ArcTan2(dy,dx) * 180 / Pi;
  Direction := Round(rad);
end;


procedure TMovingSprite.SetDirection(i:integer);
var change : boolean;
begin
  change := Direction <> i;
  FDirection := i;
  CountDXDY;
  if ( change ) and Assigned(FOnChangeDir) then FOnChangeDir(self,i);
end;


procedure TMovingSprite.SetSpeed(d:double);
begin
  FSpeed := d;
end;

procedure TMovingSprite.SetBitName(s:string);
// Kun bittikartan tiedoston nimi vaihdetaan, pyyhitään vanhat kuvat pois ja
// luodaan uudet kuvat.  Vasemmalle menevä kuva saadaan peilaamalla oikealle
// menevät kuva y-akselin suhteen.
var rect,rect2 : TRect;
    lbmp,rbmp :  TBitmap; // Vasemmalle ja oikealle menevät kuvat
begin
  FImageList.Clear;                              // Pyyhitään vanhat kuvat pois
  if ( s = '' ) then begin {Paint;} exit; end;     // Jos ei nimeä, ei kuvia
  rbmp := TBitmap.Create;                        // Luodaan tilap. bittikartat
  lbmp := TBitmap.Create;                        // Oik. ja avsemmalle

  FBitName := s;                                 // Muistetaan kuvan nimi
  rbmp.LoadFromFile(s);                          // Luetaan Oik. kuva tied.

  lbmp.Assign(rbmp);                             // Tehdään vas. identtinen
  rect.Left   := 0;                              // Apusuorakaiteet kop.
  rect.Top    := 0;
  rect.Right  := rbmp.Width;
  rect.Bottom := rbmp.Height;
  rect2       := rect;                           // rect2 on rectin peilikuva
  rect2.Right := 0;
  rect2.Left  := rect.Right;
  lbmp.Canvas.StretchDraw(rect2,rbmp);       // lbmp on rbmp:n peilikuva
//  lbmp.Canvas.CopyRect(rect2,rbmp.Canvas, rect); // Ei toimi CLX:ssä

  w  := rbmp.Width;                          // Oma koko bitmapin kokoiseksi
  h := rbmp.Height;
  FImageList.Width  := rbmp.Width;                    // Samoin kuvalistan
  FImageList.Height := rbmp.Height;
  FImageList.AddMasked(rbmp,rbmp.TransparentColor); // Kuvalistan paik. 0 rbmp
  FImageList.AddMasked(lbmp,lbmp.TransparentColor); //                  1 lbmp
 // Paint;
  lbmp.Free;                                     // Poistetaan tilap. kuvat
  rbmp.Free;
end;

function TMovingSprite.DoJob : boolean;
begin
  inherited DoJob;
  if ( StayOnParentArea ) then begin
    if ( y + dy < 0 ) then dy := abs(dy);
    if ( y + dy >= Parent.ClientHeight-h ) then dy := -abs(dy);
    if ( x + dx < 0 ) then dx := abs(dx);
    if ( x + dx >= Parent.ClientWidth-w ) then dx := -abs(dx);
    CountDirection;
  end;
  y := y + dy*Speed;
  x := x + dx*Speed;
  if Assigned(FOnMove) then FOnMove(self);
  Result := true;
end;

function TMovingSprite.PaintTo(canvas: TCanvas): boolean;
var index : integer;
begin
  index := 0; if ( dx < 0 ) then index := 1;  // Kumpiko kuva pitää piirtää
  FImageList.Draw(Canvas,ix,iy,index);
  inherited PaintTo(canvas);
  Result := true;
end;

function TMovingSprite.MovingReact(sprite: TSprite): boolean;
begin
  Result := true;
end;

function TMovingSprite.React(sprite: TSprite): boolean;
begin
  Result := inherited React(sprite);
  if ( Result ) then exit;
  Result := MovingReact(sprite);
end;



end.