Grafik Animation

[I.A]

Hallo,

Soeben habe ich aus den Lazarusbeispielen den folgenden Quelltext gefunden, den ich in diesem Forum
zeige, weil meine Frage sich eher auf ObjectPascal und Grafik bezieht, als auf Besonderheiten von Lazarus.

Es handelt sich um eine Animation. Ein Sprite läuft über ein Fenster mit Hintergrundbild.

Diese Hintergrundbild flimmert jedoch sehr stark.

Gibt es da eine bessere Möglichkeit. Da heißt, wie kriege ich einen fllimmerfreien Bildaufbau?

Kann es sein, das das Flimmern daher rührt, das hier in die Canvas Klasse gezeichnet wird und hierbei zu langsam gezeichnet wird?

Delphi-Quellcode:

unit PlayGround;

{$ifdef fpc}{$mode objfpc}{$H+}{$endif}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls;

type

  { TPictureControl }

  TPictureControl = class(TCustomControl)
    procedure PictureChanged(Sender: TObject);
  private
    FPicture: TPicture;
    procedure SetPicture(const AValue: TPicture);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
  end;

  { TPlayGroundForm }

  TPlayGroundForm = class(TForm)
    Timer1: TTimer;
    procedure PlayGroundFormClose(Sender: TObject; var CloseAction: TCloseAction
      );
    procedure PlayGroundFormCreate(Sender: TObject);
    procedure PlayGroundFormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure UpdateImage;
  public
    PictureControl: TPictureControl;
    SpriteImg: TBitmap;
    BackgroundImg: TBitmap;
    BufferImg: TBitmap;
  end;

var
  PlayGroundForm: TPlayGroundForm;

implementation

{ TPlayGroundForm }

procedure TPlayGroundForm.PlayGroundFormCreate(Sender: TObject);
begin
  PictureControl:=TPictureControl.Create(Self);
  with PictureControl do begin
    Parent:=Self;
    Align:=alClient;
  end;

  SpriteImg:=TPortableNetworkGraphic.Create;
  BackgroundImg:=TBitmap.Create;
  BufferImg:=TBitmap.Create;

  SpriteImg.LoadFromFile(SetDirSeparators('../../images/ide_icon48x48.png'));
  BackgroundImg.LoadFromFile(SetDirSeparators('../../images/lazarus.xpm'));
  BufferImg.Width:=BackgroundImg.Width;
  BufferImg.Height:=BackgroundImg.Height;
  
  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.UpdateImage;
var
  DestImg: TBitmap;
  t: Double;
  x: Int64;
  y: Integer;
  CenterX: Integer;
  CenterY: Integer;
begin
  // paint first on the buffer
  
  // paint background
  //writeln('TPlayGroundForm.UpdateImage A');
  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;
  t:=Now*86400;
  x:=CenterX+round(cos(t)*CenterX*2/3)-(SpriteImg.Width div 2);
  y:=CenterY+round(sin(t*0.7)*CenterY*2/3)-(SpriteImg.Height div 2);
  //writeln('TPlayGroundForm.UpdateImage B ',x,',',y,' ',t);
  BufferImg.Canvas.CopyRect(Rect(x,y,x+SpriteImg.Width,y+SpriteImg.Height),
                   SpriteImg.Canvas,Rect(0,0,SpriteImg.Width,SpriteImg.Height));
  //writeln('TPlayGroundForm.UpdateImage C');

  // copy to image
  DestImg:=PictureControl.Picture.Bitmap;
  DestImg.Width:=BufferImg.Width;
  DestImg.Height:=BufferImg.Height;
  DestImg.Canvas.Draw(0,0,BufferImg);
  //writeln('TPlayGroundForm.UpdateImage D');
end;

{ TPictureControl }

procedure TPictureControl.SetPicture(const AValue: TPicture);
begin
  if FPicture=AValue then exit;
  FPicture.Assign(AValue);
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.StretchDraw(Rect(0,0,Width,Height),Picture.Graphic);
  inherited Paint;
end;

initialization
  {$I playground.lrs}

end.

[DeddyH]

Versuch es mal damit (keine Ahnung, ob das unter Lazarus funktioniert):

Delphi-Quellcode:

constructor TPictureControl.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FPicture:=TPicture.Create;
  FPicture.OnChange:=@PictureChanged;
  DoubleBuffered := true;  //diese Zeile einfügen
end;

[I.A]

Hallo DaddyH,

Danke für die schnelle Antwort. Mit Doublbuffered=true ist das Flimmern weg.