Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#1

Grafiken sehr einfach animieren (Sprites mit Drehung und Zoom)

  Alt 12. Dez 2010, 13:14
Da es hier immer wieder Beiträge gibt in denen mit Panels und Images animiert wird, und der Einstieg in Offscreen-Bitmaps schwer zu fallen scheint, hier eine kleine Anregung wie man recht einfach "Sprites" animieren könnte, ohne zusätzliche Bibliotheken.
Es ist nicht so daß ich diese Form der Animation präferieren würde, jedoch denke ich kommt sie der Denkweise von Anfängern entgegen.
In beiliegendem Beispiel wird eine einziger Eintrag in einer Imagelist verwendet, hier wäre natürlich problemlos möglich verschieden Bilder zu hinterlegen für zusätzliche Animantionen, im Anhang ein Microdemo.
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList,ExCanvasTools, ExtCtrls, jpeg;

type
  TMyGraphicControl=Class(TGraphicControl)
  private
    FImageList: TImageList;
    FIMageIndex: Integer;
    FAngler: Integer;
    Fzoom: Double;
    FAngle: Integer;

    procedure SetImageIndex(const Value: Integer);
    procedure SetImagelist(const Value: TImageList);
    procedure SetAngle(const Value: Integer);
    procedure SetZoom(const Value: Double);
  protected
    Procedure Paint;override;
  published
    Constructor Create(Aowner:TComponent);override;
    Property Zoom:Double read Fzoom write SetZoom;
    Property Angle:Integer read FAngle Write SetAngle;
    Property ImageList:TImageList read FImageList Write SetImagelist;
    Property ImageIndex:Integer read FIMageIndex Write SetImageIndex;
  End;
  TForm1 = class(TForm)
    ImageList1: TImageList;
    Timer1: TTimer;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    Fzz:Double;
    FG:TMyGraphicControl;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   FG := TMyGraphicControl.Create(self);
   FG.Parent := self;
   FG.Width := ImageList1.Width;
   FG.Height := ImageList1.Height;
   FG.ImageList := Imagelist1;
   FG.ImageIndex := 0;
   FG.Left := 20;
   FG.Top := 20;
   DoubleBuffered := True;
   FZZ := 0.005;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (Fg.Zoom >= 0.95) or (FG.Zoom < 0.3) then FZZ := - FZZ;

  FG.Angle := FG.Angle + 2;
  Fg.Zoom := Fg.Zoom + FZZ;
end;

{ TMyGraphicControl }

constructor TMyGraphicControl.Create(Aowner: TComponent);
begin
  inherited;
  FZoom := 0.5;
end;

procedure TMyGraphicControl.Paint;
var
  ico:TIcon;
begin
   if assigned(FImageList) and (FimageList.Count > FImageIndex) then
      begin
         ico := TIcon.Create;
         FImageList.GetIcon(FImageIndex,ico);
         //FImageList.Draw(Canvas,0,0,FimageIndex);
         PaintGraphic(Canvas,Width div 2,Height div 2,ico,FZoom,Fangle,true);
         ico.Free;
      end;
end;

procedure TMyGraphicControl.SetAngle(const Value: Integer);
begin
  Fangle := Value;
  invalidate;
end;

procedure TMyGraphicControl.SetImageIndex(const Value: Integer);
begin
  FIMageIndex := Value;
  invalidate;
end;

procedure TMyGraphicControl.SetImagelist(const Value: TImageList);
begin
  FImageList := Value;
  Invalidate;
end;

procedure TMyGraphicControl.SetZoom(const Value: Double);
begin
  Fzoom := Value;
  invalidate;
end;

end.
und die dazugehörige, ExCanvasTools

Delphi-Quellcode:
unit ExCanvasTools;
// 20100915 by Thomas Wassermann
// www.explido-software.de
interface
uses
  Windows, SysUtils, Classes, Graphics;

  Function Grad2Rad(w:Double):Double;
  Procedure PaintGraphic(ACanvas:TCanvas;x,y:Integer;AGraphic:TGraphic;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
  Procedure PaintText(ACanvas:TCanvas;Const s:String;x,y:Integer;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
  Procedure ResetCanvas(ACanvas:TCanvas);
  procedure SetCanvasZoomAndRotation(ACanvas: TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);

implementation

Function Grad2Rad(w:Double):Double;
  begin
     Result := w / 360 * PI *2;
  end;

Procedure PaintText(ACanvas:TCanvas;Const s:String;x,y:Integer;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
var
  px,py:Integer;
begin
     SetCanvasZoomAndRotation(ACanvas , Faktor, Winkel, x,y);
     if PosIsCenter then
        begin
          px := Round( ACanvas.TextWidth(s) / 2 );
          py := Round( ACanvas.TextHeight(s) / 2 );
        end
     else
        begin
          px := 0;
          py := 0;
        end;

     ACanvas.TextOut(-px ,-py ,s);
     ResetCanvas(ACanvas);
end;




Procedure PaintGraphic(ACanvas:TCanvas;x,y:Integer;AGraphic:TGraphic;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
var
  px,py:Integer;
begin
     if PosIsCenter then
        begin
          px := Round( AGraphic.Width / 2 );
          py := Round( AGraphic.Height / 2 );
        end
     else
        begin
          px := 0;
          py := 0;
        end;
     SetCanvasZoomAndRotation(ACanvas , Faktor, Winkel, x , y );
     ACanvas.Draw(-px ,-py ,AGraphic);
     ResetCanvas(ACanvas);
end;





Procedure ResetCanvas(ACanvas:TCanvas);
begin
   SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;

Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
    form : tagXFORM;
    Winkel:Double;

begin
      Winkel := Grad2Rad(Angle);
      SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
      SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
      form.eM11 := Zoom * cos( Winkel);
      form.eM12 := Zoom *Sin( Winkel) ;
      form.eM21 := Zoom * (-sin( Winkel));
      form.eM22 := Zoom * cos( Winkel) ;
      form.eDx := CenterpointX;
      form.eDy := CenterpointY;
      SetWorldTransform(ACanvas.Handle,form);
end;

end.
Angehängte Dateien
Dateityp: zip DrehZoom.zip (515,8 KB, 166x aufgerufen)
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)

Geändert von Bummi (13. Dez 2010 um 12:31 Uhr) Grund: Offscreen-Bitmaps statt Offlinebitmaps
  Mit Zitat antworten Zitat