AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Zeichnung wird nicht richtig gezeichnet

Ein Thema von delphicoder123 · begonnen am 8. Jul 2019 · letzter Beitrag vom 10. Jul 2019
Antwort Antwort
Seite 1 von 2  1 2   
delphicoder123

Registriert seit: 14. Feb 2019
89 Beiträge
 
#1

Zeichnung wird nicht richtig gezeichnet

  Alt 8. Jul 2019, 20:46
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
Angehängte Dateien
Dateityp: zip Code.zip (943 Bytes, 0x aufgerufen)
  Mit Zitat antworten Zitat
Medium
Online

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

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 8. Jul 2019, 21:07
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.
"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)

Geändert von Medium ( 8. Jul 2019 um 21:21 Uhr)
  Mit Zitat antworten Zitat
delphicoder123

Registriert seit: 14. Feb 2019
89 Beiträge
 
#3

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 8. Jul 2019, 23:08
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?
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)
Online

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

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 8. Jul 2019, 23:12
TBitmap ist ja auch keine visuelle Komponente.

http://michael-puff.de/Programmierun...enBitmap.shtml
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
peterbelow

Registriert seit: 12. Jan 2019
Ort: Hessen
316 Beiträge
 
Delphi 10.3 Rio
 
#5

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 9. Jul 2019, 03:48
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.
Peter Below
  Mit Zitat antworten Zitat
delphicoder123

Registriert seit: 14. Feb 2019
89 Beiträge
 
#6

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 9. Jul 2019, 22:47
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.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)
Online

Registriert seit: 29. Mai 2002
37.231 Beiträge
 
Delphi 2006 Professional
 
#7

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 9. Jul 2019, 23:42
Deswegen soll man ja auch ein Mit mal im Speicher verwenden. Die vertikalen Linien müssen eben auch neu gezeichnet werden.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
26.824 Beiträge
 
Delphi 10.3 Rio
 
#8

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 10. Jul 2019, 06:27
Statt "Mit mal" geht auch eine Bitmap
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
Medium
Online

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

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 10. Jul 2019, 08:00
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.
"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
Benutzerbild von Gollum
Gollum

Registriert seit: 14. Jan 2003
Ort: Boxberg
456 Beiträge
 
Delphi 10.1 Berlin Professional
 
#10

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 10. Jul 2019, 09:30
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.
Angehängte Dateien
Dateityp: zip Unit2.zip (1,3 KB, 2x aufgerufen)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

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:33 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