AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Canvas aktualisieren ohne flackern

Canvas aktualisieren ohne flackern

Ein Thema von Frühlingsrolle · begonnen am 2. Dez 2019 · letzter Beitrag vom 4. Dez 2019
Antwort Antwort
Seite 1 von 3  1 23   
Frühlingsrolle

Registriert seit: 31. Aug 2019
110 Beiträge
 
#1

Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 17:10
Hallo Forum

Problemstellung:
Gegeben ist eine VCL-Komponente (von TControl abgeleitet) die eine analoge Uhr darstellt.
Im Moment wird das Zifferblatt und die Zeiger über TCanvas direkt in der DoPaint() Methode gezeichnet und über einen internen Timer aktualisiert.
Je nach Timer-Interval flackert es mehr oder weniger.
Hinzu kommt noch eine Hintergrundgrafik die nach Bedarf über die Eigenschaft .Picture angelegt werden kann.
Der Timer "aktualisiert" somit auch die Grafik, wodurch noch mehr Flackern ensteht.
Wie könnte man das Problem angehen, sodass weniger bis garnicht geflackert wird?

Delphi-Quellcode:
unit ufrClock;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls;

type
  TClockItem = class(TPersistent)
  private
    FColor: TColor;
    FEnabled: Boolean;
    FPicture: TPicture;
    FSize, FThickness: Integer;
    procedure SetPicture(Value: TPicture);
  public
    constructor Create; overload;
    constructor Create(ASize, AThickness: Integer; AColor: TColor;
      AEnabled: Boolean); overload;
    destructor Destroy; override;
  published
    property Color: TColor read FColor write FColor;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Picture: TPicture read FPicture write SetPicture;
    property Size: Integer read FSize write FSize;
    property Thickness: Integer read FThickness write FThickness;
  end;

type
  TfrCustomClock = class(TControl)
  private
    FCanvas: TCanvas;
    FCurrentTime: TDateTime;
    FPicture: TPicture;
    FTimer: TTimer;
    FTimerEnabled: Boolean;
    FTimerInterval: Integer;
    FHourHand, FMinuteHand, FSecondHand: TClockItem;
    FOnPaint: TNotifyEvent;
    procedure SetPicture(Value: TPicture);
    procedure SetTimerEnabled(Value: Boolean);
    procedure SetTimerInterval(Value: Integer);
  protected
    function GetAnglePoint(X, Y: Integer; Radius, Angle: Double): TPoint;
    procedure DoPaint; virtual;
    procedure DoTimer(Sender: TObject); virtual;
    procedure DrawClockFace(ACanvas: TCanvas; MX, MY, Radius: Integer); virtual;
    procedure DrawClockHands(ACanvas: TCanvas; MX, MY: Integer;
      AHourHand, AMinuteHand, ASecondHand: TClockItem; ATime: TDateTime); virtual;
    procedure WndProc(var Message: TMessage); override;
    property Picture: TPicture read FPicture write SetPicture;
    property TimerEnabled: Boolean read FTimerEnabled write SetTimerEnabled;
    property TimerInterval: Integer read FTimerInterval write SetTimerInterval;
    property HourHand: TClockItem read FHourHand write FHourHand;
    property MinuteHand: TClockItem read FMinuteHand write FMinuteHand;
    property SecondHand: TClockItem read FSecondHand write FSecondHand;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read FCanvas;
  end;

  TfrClock = class(TfrCustomClock)
  published
    property Picture;
    property HourHand;
    property MinuteHand;
    property SecondHand;
    property TimerEnabled;
    property TimerInterval;
    property OnPaint;
  end;

procedure Register;

implementation

uses Math;

const
  DEG = Pi / 180.0;
  RAD = 180.0 / Pi;

function Cos(Degree: Double): Double;
begin
  result := System.Cos(Degree * DEG);
end;

function Sin(Degree: Double): Double;
begin
  result := System.Sin(Degree * DEG);
end;

{ TClockItem }

procedure TClockItem.SetPicture(Value: TPicture);
begin
  if Assigned(FPicture) then
    FPicture.Assign(Value);
end;

constructor TClockItem.Create;
begin
  inherited;
  FPicture := TPicture.Create;
end;

constructor TClockItem.Create(ASize, AThickness: Integer; AColor: TColor;
  AEnabled: Boolean);
begin
  inherited Create;
  FPicture := TPicture.Create;
  FSize := ASize;
  FThickness := AThickness;
  FColor := AColor;
  FEnabled := AEnabled;
end;

destructor TClockItem.Destroy;
begin
  FPicture.Free;
  inherited;
end;

{ TfrCustomClock }

constructor TfrCustomClock.Create(AOwner: TComponent);
begin
  inherited;
  Width := 100;
  Height := 100;

  FCanvas := TControlCanvas.Create;
  FCanvas.Brush.Style := bsClear;
  TControlCanvas(FCanvas).Control := self;

  FPicture := TPicture.Create;

  FHourHand := TClockItem.Create(30, 3, clBlack, true);
  FMinuteHand := TClockItem.Create(50, 3, clBlack, true);
  FSecondHand := TClockItem.Create(50, 1, clRed, true);

  FCurrentTime := now;
  FTimer := TTimer.Create(self);
  TimerEnabled := true;
  TimerInterval := 100;
  FTimer.OnTimer := DoTimer;
end;

destructor TfrCustomClock.Destroy;
begin
  FSecondHand.Free;
  FMinuteHand.Free;
  FHourHand.Free;
  FPicture.Free;
  FCanvas.Free;
  inherited;
end;

procedure TfrCustomClock.SetPicture(Value: TPicture);
begin
  if Assigned(FPicture) then
    FPicture.Assign(Value);
  Repaint;
end;

procedure TfrCustomClock.SetTimerEnabled(Value: Boolean);
begin
  if Assigned(FTimer) then
  begin
    FTimer.Enabled := Value;
    FTimerEnabled := FTimer.Enabled;
  end;
end;

procedure TfrCustomClock.SetTimerInterval(Value: Integer);
begin
  if Assigned(FTimer) then
  begin
    FTimer.Interval := Value;
    FTimerInterval := FTimer.Interval;
  end;
end;

function TfrCustomClock.GetAnglePoint(X, Y: Integer; Radius, Angle: Double): TPoint;
begin
  result.X := X + Round(Cos(Angle) * Radius);
  result.Y := Y - Round(Sin(Angle) * Radius);
end;

procedure TfrCustomClock.DoPaint;
var
  pt: TPoint;
  radius: Integer;
begin
  pt.X := Width div 2;
  pt.Y := Height div 2;
  radius := Min(Width, Height) div 2; // DEMO value

  // Draw background picture
  if Assigned(Picture) then
    Canvas.Draw(0, 0, Picture.Graphic);

  // Draw clock face and hands over the background
  DrawClockFace(Canvas, pt.X, pt.Y, radius);
  DrawClockHands(Canvas, pt.X, pt.Y, HourHand, MinuteHand, SecondHand, FCurrentTime);

  if Assigned(FOnPaint) then
    FOnPaint(self);
end;

procedure TfrCustomClock.DoTimer(Sender: TObject);
begin
  if not(csDesigning in ComponentState) then
    FCurrentTime := now;

  Invalidate;
end;

// DEMO example
procedure TfrCustomClock.DrawClockFace(ACanvas: TCanvas; MX, MY, Radius: Integer);
var
  p, pp: TPoint;
  i: integer;
begin
  ACanvas.Pen.Color := clBlack;
  for i := 1 to 60 do
  begin
    if i mod 5 = 0 then
      ACanvas.Pen.Width := 3 else
      ACanvas.Pen.Width := 1;
    
    p := GetAnglePoint(MX, MY, Radius, 90 + i * -6);
    pp := getanglepoint(MX, MY, Radius - 10, 90 + i * -6);
    ACanvas.MoveTo(p.X, p.Y);
    ACanvas.LineTo(pp.X, pp.Y);
  end;
end;

procedure TfrCustomClock.DrawClockHands(ACanvas: TCanvas; MX, MY: Integer;
  AHourHand, AMinuteHand, ASecondHand: TClockItem; ATime: TDateTime);
var
  wHour, wMin, wSec, wMSec: Word;
  pt: TPoint;
  lAngle: Double;
begin
  DecodeTime(ATime, wHour, wMin, wSec, wMSec);

  // Reset background
  ACanvas.FillRect(Rect(0, 0, Width, Height));

  // Draw hour hand
  if AHourHand.Enabled then
  begin
    lAngle := 90 + (30 * wHour + (wMin / 2)) * -1;
    pt := GetAnglePoint(MX, MY, AHourHand.Size, lAngle);
    ACanvas.Pen.Width := AHourHand.Thickness;
    ACanvas.Pen.Color := AHourHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;

  // Draw minute hand
  if AMinuteHand.Enabled then
  begin
    lAngle := 90 + 6 * wMin * -1;
    pt := GetAnglePoint(MX, MY, AMinuteHand.Size, lAngle);
    ACanvas.Pen.Width := AMinuteHand.Thickness;
    ACanvas.Pen.Color := AMinuteHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;

  // Draw second hand
  if ASecondHand.Enabled then
  begin
    lAngle := 90 + (6 * wSec + (0.36 * (wMSec / 60))) * -1;
    pt := GetAnglePoint(MX, MY, AMinuteHand.Size, lAngle);
    ACanvas.Pen.Width := ASecondHand.Thickness;
    ACanvas.Pen.Color := ASecondHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;
end;

procedure TfrCustomClock.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_ERASEBKGND : Message.Result := 1;
    WM_PAINT : DoPaint;
  end;
end;

procedure Register;
begin
  RegisterComponents('Frühlingsrolle',[TfrClock]);
end;

end.
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.514 Beiträge
 
Delphi 2007 Enterprise
 
#2

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 17:16
Wenn du alternativ von TWinControl (ein Nachfahre von TControl) ableiten kannst, gäbe es die Property "DoubleBuffered", welche genau gegen solches Flackern gedacht ist.
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Frühlingsrolle

Registriert seit: 31. Aug 2019
110 Beiträge
 
#3

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 17:34
Danke für die schnelle Rückmeldung, Medium!
Doublebuffered hilft ein kleines bisschen aus, zumindest, wenn keine Hintergrundgrafik gegeben ist.
Ich suche nach einer Möglichkeit das Canvas-gezeichnete allein zu aktualisieren, ohne die gesamte Komponente aktualisieren zu müssen. Das wäre der zielführende Ansatz.
Ob die WinAPI etwas deratiges anbietet, weiss ich nicht. Und sollte es jemand besser wissen, ist er/sie mir willkommen.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.363 Beiträge
 
Delphi 2006 Professional
 
#4

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 17:36
Erst auf ein Bitmap im Speicher zeichnen und dieses im OnPaint in den Canvas kopieren.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Frühlingsrolle

Registriert seit: 31. Aug 2019
110 Beiträge
 
#5

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 17:43
Das klingt vielversprechend, danke Luckie!
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.363 Beiträge
 
Delphi 2006 Professional
 
#6

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 19:18
Und hier noch etwas Code: http://michael-puff.de/Programmierun...enBitmap.shtml
Zwar ein einfaches Beispiel, aber verdeutlicht das Prinzip.

Damit trennst du auch die Programmlogik von der Oberfläche und kannst deine Uhr auf jedes beliebige Canvas zeichnen ohne den Code anpassen zu müssen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.514 Beiträge
 
Delphi 2007 Enterprise
 
#7

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 20:15
Das ist übrigens dieselbe Taktik, die "DoubleBuffered" intern nutzt
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Frühlingsrolle

Registriert seit: 31. Aug 2019
110 Beiträge
 
#8

AW: Canvas aktualisieren ohne flackern

  Alt 2. Dez 2019, 23:42
So richtig will es mir nicht gelingen. Ich bekomm' lediglich eine weiße Fläche zu sehen bei folgender Anpassung:

Delphi-Quellcode:
private
  FBitmap: TBitmap;

// constructor
FBitmap := TBitmap.Create;
FBitmap.Width := Width;
FBitmap.Height := Height;
FBitmap.Transparent := true;
FBitmap.TransparentColor := clWhite;
FBitmap.Canvas.Brush.Color := clWhite;

procedure TfrCustomClock.DoPaint;
begin
  // Draw background picture
  if Assigned(Picture) and Assigned(Picture.Graphic) then
    Canvas.Draw(0, 0, Picture.Graphic);

  BitBlt(Canvas.Handle, 0, 0, Width, Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);

  if Assigned(FOnPaint) then
    FOnPaint(self);
end;

procedure TfrCustomClock.DoTimer(Sender: TObject);
var
  pt: TPoint;
  radius: Integer;
begin
  if not(csDesigning in ComponentState) then
    FCurrentTime := now;

  pt.X := Width div 2;
  pt.Y := Height div 2;
  radius := Min(Width, Height) div 2; // DEMO value

  FBitmap.Canvas.FillRect(Rect(0, 0, FBitmap.Width, FBitmap.Height));
  DrawClockFace(FBitmap.Canvas, pt.X, pt.Y, radius);
  DrawClockHands(FBitmap.Canvas, pt.X, pt.Y, HourHand, MinuteHand, SecondHand, FCurrentTime);
end;

procedure TfrCustomClock.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_SIZE : FBitmap.SetSize(Width, Height);
    WM_ERASEBKGND : Message.Result := 1;
    WM_PAINT : DoPaint;
  end;
end;
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.514 Beiträge
 
Delphi 2007 Enterprise
 
#9

AW: Canvas aktualisieren ohne flackern

  Alt 3. Dez 2019, 00:50
Ich würde das mit der Transparenz komplett raus nehmen. Das ist, gerade wenn man ein wenig hin und her zeichnet, gern auch mal nicht berücksichtigt. Mal einfach alles am Stück auf das Bitmap, und wirf es im DoPaint() komplett mit einem BitBlt() Aufruf auf das Control-Canvas.

Wenn du unbedingt das Neuzeichnen des Hintergrunds vermeiden willst, nimm dafür einfach ein 2. Bitmap das nur den Hintergrund bekommt. Mal das im Timer auf das "finale" Bitmap, Zeiger drüber, und das dann im DoPaint auf den Canvas.
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Frühlingsrolle

Registriert seit: 31. Aug 2019
110 Beiträge
 
#10

AW: Canvas aktualisieren ohne flackern

  Alt 3. Dez 2019, 03:06
Von der Transparenz mal abgesehen, erweist sich der Zwischenschritt über das TBitmap für sinnlos.
Der Timer muss ein Neuzeichnen in Gang setzen, ansonsten wird auf der Ziel-Oberfläche nichts abgebildet. D.h. ich bin wieder am Anfang.
Hier eine kleine Demo dazu:

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, ExtCtrls, Math;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
    FAngle: Double;
    FBitmap: TBitmap;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetAnglePoint(X, Y: Integer; Radius, Angle: Double): TPoint;
begin
  result.X := X + Round(Cos(DegToRad(Angle)) * Radius);
  result.Y := Y - Round(Sin(DegToRad(Angle)) * Radius);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FBitmap.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FAngle := 0;

  FBitmap := TBitmap.Create;
  FBitmap.SetSize(100, 100);

  Paintbox1.SetBounds(120, 10, 100, 100);

  Timer1.Interval := 100;
  Timer1.Enabled := true;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(Paintbox1.Canvas.Handle, 0, 0, Paintbox1.Width, Paintbox1.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt: TPoint;
begin
  // kann ebenso in der Paintbox-Paint-Methode ausgeführt werden
  pt := GetAnglePoint(50, 50, 50, FAngle);
  FBitmap.Canvas.FillRect(Rect(0, 0, 100, 100));
  FBitmap.Canvas.MoveTo(50, 50);
  FBitmap.Canvas.LineTo(pt.X, pt.Y);
  self.Canvas.Draw(10, 10, FBitmap);
  FAngle := FAngle + 3;
  //

  Paintbox1.Repaint; // muss dennoch ausgeführt werden!
end;

end.
Verblüffend, dass weder auf dem Bitmap noch auf der Paintbox etwas flackert. Ob das an der Einfachheit dieser Demo liegt, wage ich zu bezweifeln.
Etwas stimmt mit meinem Canvas-Objekt (aus dem 1. Beitrag) nicht.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 3  1 23   

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 13:45 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf