AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Grafik Animation

Ein Thema von I.A · begonnen am 20. Dez 2008 · letzter Beitrag vom 20. Dez 2008
Antwort Antwort
I.A

Registriert seit: 14. Jan 2007
83 Beiträge
 
#1

Grafik Animation

  Alt 20. Dez 2008, 14:56
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.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.534 Beiträge
 
Delphi 11 Alexandria
 
#2

Re: Grafik Animation

  Alt 20. Dez 2008, 15:03
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;
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
I.A

Registriert seit: 14. Jan 2007
83 Beiträge
 
#3

Re: Grafik Animation

  Alt 20. Dez 2008, 15:28
Hallo DaddyH,

Danke für die schnelle Antwort. Mit Doublbuffered=true ist das Flimmern weg.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz