Wieder mal das leidige Thema "Flackern"

[TiGü]

Zitat von skoschke:

Siehe meine Antwort an Stahli, eigentlich möchte ich Controls flackerfrei bewegen können, der Umweg über die Paintbox war ein Ansatz das zu umgehen...

Ich verstehe immer nicht, warum es vielen so schwer fällt ein kleines Programm mit den minimal notwendigen Inhalten zu erstellen.
Kein Hexenwerk: File -> New -> VCL Forms Application
Dann die notwendigen Teile deines bisherigen Quelltextes reinkopieren, kompilieren, kurz testen, ob das Problem daran reproduziert werden kann und hochladen.

Das hätte dich schon viel weiter gebracht, anstatt dir den esoterischen Lösungsvorschlag von Stahli erläutern zu lassen.

[skoschke]

Wenn das mit dem kleinen Beispielprojekt so einfach wäre...

Im Original stecken etliche eigene Controls sowie Fremdkomponenten drin, da ein Miniprojekt basteln was Panels verschiebt, bringt mich da wenig weiter!
Und wenn ich es mit den Fremdkomponenten baue kann es niemand compilieren.

Das Projekt, bei dem es jetzt klemmt, ist reiner Source bereits 2MB groß!

Ciao
Stefan

[TiGü]

Aha, also flackern nicht die VCL-Standard-Controls wie Panel, Button, Label und Edit beim verschieben, sondern die externen Fremdkomponenten.
Ist das so richtig?

[hoika]

Hallo,

Zitat:

da ein Miniprojekt basteln was Panels verschiebt, bringt mich da wenig weiter!

Klar, wenn es flackert ...

Bei TeX hiess das auch immer: Minimal-Beispiel.

[stahli]

Zitat von TiGü:

Das hätte dich schon viel weiter gebracht, anstatt dir den esoterischen Lösungsvorschlag von Stahli erläutern zu lassen.

Es war ca. 2012/13, als ich das so umgesetzt hatte.
Details weiß ich jetzt so genau nicht mehr, aber es war nicht so einfach, Controls und Graphik drum herum nahtlos darzustellen.

[Michael II]

Wenn du das nicht mit FireMonkey programmieren willst/kannst, dann lade doch mal Graphics32 runter und verwende Layers.

Ein gutes Beispiel findest du unter:
Graphics32\Examples\Vcl\Layers\Sprites_Ex


Du kannst BitMaps (inkl. Transparenz, also ARGB) definieren, und die Z-Order festlegen.

Wenn du die Dinger dann rumschiebst, gibst du lediglich die neuen Koordinaten der Bitmaps an.

Das Ganze läuft ruckelfrei und schnell.

[jziersch]

Das Flackern kommt meist durch das löschen des Hintergrundes durch windows.
Wenn man die wmerasebk o.ae. message des hintergrund objektes bzw. Form abfängt kann man das Flackern verhindern.
Sorry, kann gerade kein Beispiel bauen

[Uwe Raabe]

Einfach mal probeweise diese Klassendeklaration vor das Form schreiben, in dem die Paintbox liegt.

Delphi-Quellcode:

type
  TPaintBox = class(Vcl.ExtCtrls.TPaintBox)
  private
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  end;

Die Implementierung ist relativ simpel.

Delphi-Quellcode:

procedure TPaintBox.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

[jziersch]

Bei der TPaintBox klappt das nicht. Das muss ein WinControl sein. Also am besten in dem TForm welches das unmittelbare parent der TPaintBox ist.

[Uwe Raabe]

Zitat von jziersch:

Bei der TPaintBox klappt das nicht. Das muss ein WinControl sein. Also am besten in dem TForm welches das unmittelbare parent der TPaintBox ist.

Richtig

Hier mal ein Beispiel, wie es funktionieren könnte:

Delphi-Quellcode:

object Form448: TForm448
  Left = 0
  Top = 0
  Caption = 'Form448'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 635
    Height = 299
    Align = alClient
    OnMouseMove = PaintBox1MouseMove
    OnPaint = PaintBox1Paint
    ExplicitLeft = 137
    ExplicitTop = 80
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
end

Delphi-Quellcode:

unit Unit448;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.Classes, System.SysUtils,
  Vcl.Forms, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics;

type
  TForm448 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormResize(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    FBitmap: TBitmap;
    function GetBitmap: TBitmap;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  public
    destructor Destroy; override;
    property Bitmap: TBitmap read GetBitmap;
  end;

var
  Form448: TForm448;

implementation

{$R *.dfm}

destructor TForm448.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

procedure TForm448.FormResize(Sender: TObject);
begin
  Bitmap.SetSize(ClientWidth, ClientHeight);
end;

function TForm448.GetBitmap: TBitmap;
begin
  if FBitmap = nil then begin
    FBitmap := TBitmap.Create;
  end;
  Result := FBitmap;
end;

procedure TForm448.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Bitmap.Canvas.Brush.Color := clGray;
  Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
  Bitmap.Canvas.TextOut(10, 10, FormatDateTime('c', Now));
  Bitmap.Canvas.MoveTo(0, Y);
  Bitmap.Canvas.LineTo(Width, Y);
  PaintBox1.Invalidate;
end;

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

procedure TForm448.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

end.