unit tappydrawer; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Controls, Graphics, LCLType, IntfGraphics, fpimage, Math, {tappygamedata,} tappyconfig, tappymodules; type { TTappyTuxAnimation } TTappyTuxAnimation = class StartPoint, EndPoint: TPoint; CurrentStep: Integer; StepCount: Integer; IsInfinite: Boolean; // if True the animation will never end constructor Create; virtual; procedure DrawToCanvas(ACanvas: TCanvas); virtual; procedure DrawToIntfImg(AIntfImage: TLazIntfImage); virtual; procedure ExecuteFinal; virtual; end; { TTappySpriteAnimation } TTappySpriteAnimation = class(TTappyTuxAnimation) public //StartPoint, EndPoint: TPoint; override; Bitmaps: array of TFPImageBitmap; procedure DrawToIntfImg(AIntfImage: TLazIntfImage); override; procedure ExecuteFinal; override; end; { TBallonAnimation TBallonAnimation = class(TTappyTuxAnimation) public constructor Create; override; procedure DrawToCanvas(ACanvas: TCanvas); override; procedure ExecuteFinal; override; end;} { TFallingText } TFallingText = class(TTappyTuxAnimation) public //StartPoint, EndPoint: TPoint; override; Bitmap: TFPImageBitmap; Question: TCanvas; procedure DrawToIntfImg(AIntfImage: TLazIntfImage); override; procedure ExecuteFinal; override; end; { TTappyTuxDrawer } TTappyTuxDrawer = class(TCustomControl) private imgSomething: TPortableNetworkGraphic; FAnimationList: TFPList; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure EraseBackground(DC: HDC); override; procedure Paint; override; procedure DrawToCanvas(ACanvas: TCanvas); class procedure DrawImageWithTransparentColor( ADest: TLazIntfImage; const ADestX, ADestY: Integer; AColor: TFPColor; AImage: TFPImageBitmap); //function GetImage(ATile: TChessTile): TPortableNetworkGraphic; procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HandleOnTimer(Sender: TObject); procedure AddAnimation(AAnimation: TTappyTuxAnimation); function GetAnimation(AIndex: Integer): TTappyTuxAnimation; function GetAnimationCount: Integer; procedure HandleAnimationOnTimer(); end; var vTappyTuxDrawer: TTappyTuxDrawer; implementation { TBallonAnimation constructor TBallonAnimation.Create; begin inherited Create; CurrentStep := 0; StepCount := 200; end; procedure TBallonAnimation.DrawToCanvas(ACanvas: TCanvas); begin ACanvas.Pixels[CurrentStep, CurrentStep] := clRed; end; procedure TBallonAnimation.ExecuteFinal; begin // Lost the game if the ballon reached its end end} { TTappySpriteAnimation } procedure TTappySpriteAnimation.DrawToIntfImg(AIntfImage: TLazIntfImage); var lNumBitmaps, lCurBmpIndex: Integer; t: Double; lPos: TPoint; begin lNumBitmaps := Length(Bitmaps); if lNumBitmaps = 0 then Exit; lCurBmpIndex := CurrentStep mod lNumBitmaps; t := CurrentStep / StepCount; lPos.X := Round(StartPoint.X + t * (EndPoint.X - StartPoint.X)); lPos.Y := Round(StartPoint.Y + t * (EndPoint.Y - StartPoint.Y)); TTappyTuxDrawer.DrawImageWithTransparentColor(AIntfImage, lPos.X, lPos.Y, colFuchsia, Bitmaps[lCurBmpIndex]); end; procedure TTappySpriteAnimation.ExecuteFinal; begin inherited ExecuteFinal; end; {TFallingText} procedure TFallingText.DrawToIntfImg(AIntfImage: TLazIntfImage); var t: Double; lPos: TPoint; begin t := CurrentStep / StepCount; lPos.X := Round(StartPoint.X + t * (EndPoint.X - StartPoint.X)); lPos.Y := Round(StartPoint.Y + t * (EndPoint.Y - StartPoint.Y)); TTappyTuxDrawer.DrawImageWithTransparentColor(AIntfImage, lPos.X, lPos.Y, colFuchsia, Bitmap); end; procedure TFallingText.ExecuteFinal; begin inherited ExecuteFinal; end; { TTappyTuxAnimation } constructor TTappyTuxAnimation.Create; begin inherited Create; CurrentStep := 0; StepCount := 20; end; procedure TTappyTuxAnimation.DrawToCanvas(ACanvas: TCanvas); begin end; procedure TTappyTuxAnimation.DrawToIntfImg(AIntfImage: TLazIntfImage); begin end; procedure TTappyTuxAnimation.ExecuteFinal; begin // inherit from this class and add something to ExecuteFinal end; constructor TTappyTuxDrawer.Create(AOwner: TComponent); begin inherited Create(AOwner); FAnimationList := TFPList.Create; // Events OnMouseMove := @HandleMouseMove; OnMouseUp := @HandleMouseUp; OnMouseDown := @HandleMouseDown; end; destructor TTappyTuxDrawer.Destroy; begin FAnimationList.Free; inherited Destroy; end; procedure TTappyTuxDrawer.EraseBackground(DC: HDC); begin // Don't erase the background end; procedure TTappyTuxDrawer.Paint; var x, y: integer; Bitmap: TBitmap; begin Bitmap := TBitmap.Create; try // Initializes the Bitmap Size Bitmap.Height := Height; Bitmap.Width := Width; DrawToCanvas(Bitmap.Canvas); Canvas.Draw(0, 0, Bitmap); finally Bitmap.Free; end; end; procedure TTappyTuxDrawer.DrawToCanvas(ACanvas: TCanvas); var col, row: integer; lIntfImage: TLazIntfImage; lTmpBmp: TBitmap; X, Y: integer; i: Integer; lAnimation: TTappyTuxAnimation; begin lIntfImage := TLazIntfImage.Create(0, 0); lTmpBmp := TBitmap.Create; try // First draw the background lIntfImage.LoadFromBitmap(GetCurrentModule().GetBackgroundImage(2).Handle, 0{bmpBoard.MaskHandle}); // Draw all animations via TLazIntfImage for i := 0 to FAnimationList.Count - 1 do begin lAnimation := TTappyTuxAnimation(FAnimationList.Items[i]); lAnimation.DrawToIntfImg(lIntfImage); end; lTmpBmp.LoadFromIntfImage(lIntfImage); ACanvas.Draw(0, 0, lTmpBmp); // ------------------------- // Now TCanvas drawings // ------------------------- // Now the module should draw itself // Draw all animations via TLazIntfImage for i := 0 to FAnimationList.Count - 1 do begin lAnimation := TTappyTuxAnimation(FAnimationList.Items[i]); lAnimation.DrawToCanvas(ACanvas); end; finally lTmpBmp.Free; lIntfImage.Free; end; end; class procedure TTappyTuxDrawer.DrawImageWithTransparentColor(ADest: TLazIntfImage; const ADestX, ADestY: Integer; AColor: TFPColor; AImage: TFPImageBitmap); var x, y, CurX, CurY: Integer; IntfImage: TLazIntfImage; lDrawWidth, lDrawHeight: Integer; CurColor: TFPColor; begin IntfImage := TLazIntfImage.Create(0,0); try IntfImage.LoadFromBitmap(AImage.Handle, AImage.MaskHandle); // Take care not to draw outside the destination area lDrawWidth := Min(ADest.Width - ADestX, AImage.Width); lDrawHeight := Min(ADest.Height - ADestY, AImage.Height); for y := 0 to lDrawHeight - 1 do begin for x := 0 to lDrawWidth - 1 do begin CurX := ADestX + x; CurY := ADestY + y; // Never draw outside the destination if (CurX < 0) or (CurY < 0) then Continue; CurColor := AImage.Canvas.Colors[x, y]; // Good for debugging if ((CurColor.Green div $FF) <> (AColor.Green div $FF)) or ((CurColor.Red div $FF) <> (AColor.Red div $FF)) or ((CurColor.Blue div $FF) <> (AColor.Blue div $FF)) then ADest.Colors[CurX, CurY] := IntfImage.Colors[x, y]; end; end; finally IntfImage.Free; end; end; procedure TTappyTuxDrawer.HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin { if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then FDelegate.HandleMouseMove(Sender, Shift, X, Y);} end; procedure TTappyTuxDrawer.HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then FDelegate.HandleMouseUp(Sender, Button, Shift, X, Y);} end; procedure TTappyTuxDrawer.HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then FDelegate.HandleMouseDown(Sender, Button, Shift, X, Y);} end; procedure TTappyTuxDrawer.HandleOnTimer(Sender: TObject); begin { if FDrawerState = dsRunningAnimation then begin Inc(FAnimation.CurrentStep); if FAnimation.CurrentStep >= FAnimation.FinalStep then begin FAnimation.ExecuteFinal; FAnimation.Free; FAnimation := nil; FDrawerState := dsIdle; end; Invalidate(); end;} end; procedure TTappyTuxDrawer.AddAnimation(AAnimation: TTappyTuxAnimation); begin FAnimationList.Add(AAnimation); end; function TTappyTuxDrawer.GetAnimation(AIndex: Integer): TTappyTuxAnimation; begin Result := TTappyTuxAnimation(FAnimationList.Items[AIndex]); end; function TTappyTuxDrawer.GetAnimationCount: Integer; begin Result := FAnimationList.Count; end; procedure TTappyTuxDrawer.HandleAnimationOnTimer; var i: Integer; lAnimation: TTappyTuxAnimation; begin for i := 0 to FAnimationList.Count - 1 do begin lAnimation := TTappyTuxAnimation(FAnimationList.Items[i]); Inc(lAnimation.CurrentStep); if lAnimation.InheritsFrom(TFallingText) then lAnimation.StartPoint.y := lAnimation.StartPoint.y + 10; end; Self.Invalidate; end; end.