Zeichnung wird nicht richtig gezeichnet

[delphicoder123]

Hallo,
ich habe folgendes Problem:

Wenn ich auf der Paintbox in der unteren rechten Ecke ein Rechteck zeichnen will, dann wird das Rechteck nach dem Scrollen nicht vollständig angezeigt. Was muss ich ändern, damit das Rechteck nach dem runterscrollen vollständig angezeigt wird?

Hier ein Video zu dem Problem (20s):

https://youtu.be/EETK1P1oG8g

Mein Code:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  protected
    procedure Paint; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Paint;
begin
  inherited;
    //paintbox1.Canvas.Rectangle(5,5,300,200);
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  paintbox1.Canvas.Rectangle(X,Y,X+200,Y+300);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  paint;
end;

end.

Vielen Dank

[Medium]

Du hast zwar das OnPaint-Ereignis der PaintBox versorgt, rufst dort aber lediglich implizit genau dasselbe wieder auf. (Letztlich eine Dauerschleife (eigentlich auch nicht genau das, aber ähnlich), die aber vermutlich wegen der "dazwischen sitzenden" Windows-Messages nicht zum Einfrieren führt.)

Du musst im OnPaint immer wieder alles neu zeichnen! Üblicherweise macht man das, indem man nicht direkt auf die PaintBox malt, sondern in ein TBitmap. Dieses lässt man dann im OnPaint einfach ausgeben.

Edit: Kleine Zusatzinfo, die erstmal nicht so intuitiv ist: Eine PaintBox hat "kein Gedächtnis". Sie vergisst sofort alles was man nicht auch sieht. Probiere mal in deinem Video wieder zurück zu scrollen - das Rechteck oben links müsste genau da abgeschnitten sein wo es außerhalb des Fensters war. Oder ziehe mal ein anderes Fenster quer über deins hinweg. Radiergummi.
OnPaint wird immer aufgerufen, wenn Windows meint, dass ggf. etwas sichtbar wird, was vorher durch etwas anderes verdeckt war*. (Also relativ häufig sogar.) Und du musst immer selbst dafür sorgen, dass alles was man sehen sollte dann auch wirklich frisch gezeichnet wird. Die vorgenannte Methode mit dem Bitmap macht insbesondere Sinn, weil man sich dann nicht alle jemals gemachten "Canvas.Rectangle()" (order Verwandte) merken muss, und auch weil ein Bitmap sehr schnell im OnPaint gemalt wird. (Im Schnitt schneller, als alle Zeichenoperationen separat wieder auszuführen.)

*) Oder man löst es selbst aus, z.B. durch Aufruf der Methode .Paint() ;) Deswegen oben der Hinweis auf "Dauerschleife". Ist es in dem Fall nur nicht, weil .Paint() nicht das OnPaint direkt wieder aufruft, sondern Windows dazu veranlasst deinem Programm eine Message zu schicken, dass es sich doch bitte neu zeichnen möge. (Das Message-Handling erledigt Delphi hinter den Kulissen für dich schon.) Daher wird dein Programm so wie gezeigt gerade super schnell immer wieder PaintBox1Paint() aufrufen, aber es bleibt nicht hängen, weil es eben mittelbar über das Message-System geht. Paint() gehört niemals im Ereignis-Handler für OnPaint() aufgerufen.

[delphicoder123]

Hallo,
danke für deine Hilfe.
Zwei Fragen hätte ich noch.

1) Finde ich im Objektinspektor keine TBitmap?
2) Hat die Scrollbox kein onscroll Event, sodass ich nach dem scrollen alles neu zeichnen kann.


Kannst du mir da weiterhelfen?

[Luckie]

TBitmap ist ja auch keine visuelle Komponente.

http://michael-puff.de/Programmierun...enBitmap.shtml

[peterbelow]

Zitat:

Zitat von delphicoder123 (Beitrag 1436332)

Hallo,
danke für deine Hilfe.
Zwei Fragen hätte ich noch.

1) Finde ich im Objektinspektor keine TBitmap?
2) Hat die Scrollbox kein onscroll Event, sodass ich nach dem scrollen alles neu zeichnen kann.


Kannst du mir da weiterhelfen?

Du brauchst nicht auf das Scrollen zu reagieren, das macht die VCL schon und sorgt dafür, das der OnPaint-Event der Paintbox aufgerufen wird. Du mußt Dir nur irgendwie merken, was da schon gezeichnet wurde (z. B. in einer TList<TRect>, wenn es nur um Rechtecke geht), damit Du alles auf Zuruf (im OnPaint-Event) neu zeichnen kannst.

Du kannst übrigens auch anstelle einer TPaintbox ein TImage als Zeichenfläche verwenden. TImage erzeugt intern eine TBitmap, der Image.Canvas ist eigentlich der Canvas der Bitmap. TImage sorgt selbst für die Anzeige, Du brauchst da also keinen onPaint-Event zu bearbeiten und die Bitmap "behält" was schon drauf gezeichnet wurde.

[delphicoder123]

Vielen Dank für eure bisherigen Antworten.
Ich habe, den Code jetzt so umgeändert, dass ich ein TImage anstatt einer Paintbox verwende.
Trotzdem ist mir ein "ungewöhnliches" Verhalten aufgefallen.

Beim Verschieben des Rechtecks sind die vertikalen Linien nicht komplett durchgezogen.
Woran liegt das?

(20s Video):
https://youtu.be/3GSavpXewLE

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  x1,x2,y1,y2:Integer;
implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
  var i:Integer;
begin
 for i := 0 to 30 do
   begin
    image1.Canvas.MoveTo(30*i, 0);
    image1.Canvas.LineTo(30*+i, image1.Height);
   end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  image1.canvas.Pen.Color:=clwhite;
  image1.Canvas.Rectangle(x1,y1,x2,y2);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  image1.canvas.Pen.Color:=clblack;
  x1:=X;
  x2:=X+100;
  y1:=Y;
  y2:=Y+100;
  image1.canvas.Pen.Color:=clblack;
  image1.Canvas.Rectangle(x1,y1,x2,y2);
end;

end.

[Luckie]

Deswegen soll man ja auch ein Mit mal im Speicher verwenden. Die vertikalen Linien müssen eben auch neu gezeichnet werden.

[DeddyH]

Statt "Mit mal" geht auch eine Bitmap :mrgreen:

[Medium]

Du übermalst die Linien ja auch. Bei allem was du selber zeichnest, musst du, wenn sich etwas "bewegt", auch selber dafür sorgen, dass das was hinter dem bewegten Teil war wieder neu gezeichnet wird wenn es wieder sichtbar sein soll.

[Gollum]

Hallo delphicoder123,

anbei ein einfaches Beispiel, in dem das Rechteck nach Mausklick gezeichnet und der Hintergrund aktualisiert wird.

Delphi-Quellcode:

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    ScrollBox1: TScrollBox;
    imgAusgabe: TImage;
    procedure imgAusgabeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    x1, x2, y1, y2:Integer;
    bmpHintergrund:TBitmap;

    procedure InitHintergrund();
    procedure Ausgabe();
  public
  end;

var
  Form2: TForm2;


implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  x1:=0;
  y1:=0;
  x2:=0;
  y2:=0;
  bmpHintergrund:=TBitmap.Create();
  bmpHintergrund.SetSize(ScrollBox1.Width*2, ScrollBox1.Height*2);
  bmpHintergrund.Canvas.Brush.Color:=clYellow;
  bmpHintergrund.Canvas.Pen.Color:=clNavy;
  bmpHintergrund.Canvas.Pen.Width:=2;
  imgAusgabe.SetBounds(0, 0, bmpHintergrund.Width, bmpHintergrund.Height);

  InitHintergrund();
  Ausgabe();
end;


procedure TForm2.FormDestroy(Sender: TObject);
begin
  bmpHintergrund.Free();
end;


procedure TForm2.InitHintergrund();
var i, dx:Integer;
begin
  dx:=imgAusgabe.Width div 30;

  bmpHintergrund.Canvas.FillRect(bmpHintergrund.Canvas.ClipRect);
  for i:=0 to 29 do
  begin
    bmpHintergrund.Canvas.MoveTo(dx*i, 0);
    bmpHintergrund.Canvas.LineTo(dx*i, imgAusgabe.Height);
  end; // for i
end; // TForm2.InitHintergrund


procedure TForm2.Ausgabe();
begin
  imgAusgabe.Picture.Assign(bmpHintergrund);
  imgAusgabe.Canvas.Rectangle(x1, y1, x2, y2);
end; // TForm2.Ausgabe


procedure TForm2.imgAusgabeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin
    x1:=x;
    x2:=x+100;
    y1:=y;
    y2:=y+100;
    Ausgabe();
  end; // if
end;
end.