Canvas.Polyline

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Canvas.Polyline

Beitrag von wennerer »

Hallo,
ich bin da auf was gestossen was ich nicht verstehe. Ich möchte eine Polyline in einer Paintbox zeichnen. Dafür habe ich eine Form erzeugt, darauf eine Paintbox gesetzt und möchte nun das Array der Polylinepunkte mit MouseDown füllen. Soweit so gut. Mein Problem ist nun das mit jedem MousDown zu den X und Y Werten die in MouseDown in das Array gegeben wurden die Werte Paintbox1.Left und .Top hinzu addiert werden. Das bedeutet mit jedem klick wandern meine gesetzten Punkt nach unten und rechts. Warum ist das so? Das Rechteck das ich in der Paintmethode zeichne hat doch auch den richtigen Wert? Ist vielleicht noch wichtig in probiere in Ubuntu.
Vielleicht kann mir jemand erklären was ich da falsch mach.
Viele Grüße Bernd

Code: Alles auswählen

 
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Label1    : TLabel;
    Paintbox1 : TPaintbox;
    procedure FormCreate(Sender: TObject);
    procedure Paintbox1Paint(Sender: TObject);
    procedure PaintboxMouseDown(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1     : TForm1;
  Punkte    : array of TPoint;
  AnzPu     : integer;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Left        := 200;
  Form1.Top         := 100;
  Form1.Width       := 800;
  Form1.Height      := 600;
  Form1.Color       := clsilver;
 
  Label1            := TLabel.Create(self);
  Label1.Parent     := Form1;
  Label1.AutoSize   := false;
  Label1.Left       :=  10;
  Label1.Top        :=  20;
  Label1.Width      := 150;
  Label1.Height     :=  25;
  Label1.Color      := clwhite;
 
  Paintbox1            := TPaintbox.Create(self);
  Paintbox1.Parent     := Form1;
  Paintbox1.Left       :=  10;
  Paintbox1.Top        :=  50;
  Paintbox1.Width      := 780;
  Paintbox1.Height     := 540;
  Paintbox1.OnPaint    := @Paintbox1Paint;
  Paintbox1.OnMouseDown:= @PaintboxMouseDown;
 
  AnzPu :=0;
 
end;
 
procedure TForm1.Paintbox1Paint(Sender: TObject);
begin
 Paintbox1.Canvas.Brush.Color   := clwhite;
 Paintbox1.Canvas.Rectangle(0,0,780,540);
 
 Paintbox1.Canvas.Polyline(Punkte);
 
 
end;
 
procedure TForm1.PaintboxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 //Label1.Caption := 'X: '+inttostr(x)+'Y: '+inttostr(y);
 
 setlength(Punkte,AnzPu+1);
 
 Punkte[AnzPu].X:=x-10;
 Punkte[AnzPu].Y:=y-50;
 
 inc(AnzPu);
 
 Paintbox1.Invalidate;
 
 Label1.Caption:='X[0]:'+inttostr(Punkte[0].X)+'Y[0]:'+inttostr(Punkte[0].Y)
end;
 
end.
 
 

Benutzeravatar
fliegermichl
Lazarusforum e. V.
Beiträge: 1432
Registriert: Do 9. Jun 2011, 09:42
OS, Lazarus, FPC: Lazarus Fixes FPC Stable
CPU-Target: 32/64Bit
Wohnort: Echzell

Re: Canvas.Polyline

Beitrag von fliegermichl »

Ich hab das unter Windows mal ausprobiert, da wandert nichts.

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Canvas.Polyline

Beitrag von wp_xyz »

Auch bei mir tritt der Fehler nicht auf.

Warum ich trotzdem antworte, auch wenn es nichts mit dem genannten Problem zu tun hat: An dem Code gefällt mir nicht, dass der Name des Formulars im Code der Klasse verwendet wird. Es gibt dafür stattdessen den Bezeichner "self". Andernfalls funktioniert das Formular nur, wenn es genauso heißt wie angegeben. Also statt

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Left        := 200;   // Das funktioniert nur, wenn das erzeugte Formular auch "Form1" heißt! Die Klasse soll aber unabhängig davon sein.
  Form1.Top         := 100;
  Form1.Width       := 800;
  Form1.Height      := 600;
  Form1.Color       := clsilver;
 
  Label1            := TLabel.Create(self);
  Label1.Parent     := Form1;
  ...

lieber das:

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Left        := 200// Kein "Form1"
  Top         := 100;
  Width       := 800;
  Height      := 600;
  Color       := clsilver;
 
  Label1            := TLabel.Create(self);
  Label1.Parent     := self;   // statt "Form1"
  ...

Außerdem ist ungeschickt, die Paintbox und das Label gleich unter "class(TForm)" zu deklarieren. Sie befinden sich damit im "published"-Abschnitt (auch wenn's nicht explizit dort steht) und stehen damit unter Kontrolle der IDE. Du musst dich nicht wundern, wenn die IDE sie irgendwann herauslöscht. Also besser:

Code: Alles auswählen

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Paintbox1Paint(Sender: TObject);
    procedure PaintboxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
    Paintbox1: TPaintbox;   // nicht direkt unter "class(TForm)"
    Label1    : TLabel;
  public
    { public declarations }
  end;

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Canvas.Polyline

Beitrag von wennerer »

Vielen Dank an euch beide fürs probieren!
@ wp_xyz: Ich werde deine Verbesserungen gerne beherzigen, erspart mir in Zukunft vielleicht das Ein oder Andere. Und es sollte auch hier dann nicht so stehen bleiben (mein Wissen beruht nur auf probieren).
Aber wenn es bei euch funktioniert liegt der Grund für mein Problemchen offensichtlich nicht in meinem Code? Wenn ich in die Paintbox klicke , die Maus nicht bewege, wieder klicke usw. wandert mit jedem klick die Linie nach unten und rechts. Und zwar um soviel wie die Paintbox in die Form verschoben ist. Ich habe eben noch gesehen das in meinem Beispiel in der MouseDown beim zuweisen der X und Y Werte die -10 bzw. -50 verrechnet werden. Da hab ich rumprobiert und das wollte ich eigentlich vor dem Hochladen wieder löschen. Macht aber für die Funktion keinen Unterschied.
Viele Grüße Bernd

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Canvas.Polyline

Beitrag von wp_xyz »

Problem bei solchen Code-Ausschnitten ist immer, dass man nie weiß, was sonst noch alles passiert. Am liebsten wäre mir immer ein vollständiges Minimalprojekt, das mit allen benötigten Dateien (aber nur mit diesen, also kein vom Compiler erzeugten) als zip ins Forum hochgeladen ist; dann kann man das ausprobieren und den Fehler bestätigen oder nicht. Auch fehlt mir noch die Angabe zur Lazarus-/FPC-Version und zum Betriebssystem.

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Canvas.Polyline

Beitrag von wennerer »

Okay,
ich verwende FPC 3.0.0 und Lazarus 1.6+dfsg-1. Mein Betriebssystem ist Ubuntu 16.04 LTS mit 32 Bit.
Vielen Dank Bernd

Ich probiere diesen Code:

Code: Alles auswählen

 
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
 
    procedure FormCreate(Sender: TObject);
    procedure Paintbox1Paint(Sender: TObject);
    procedure PaintboxMouseDown(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
    Label1    : TLabel;
    Paintbox1 : TPaintbox;
  public
    { public declarations }
  end;
 
var
  Form1     : TForm1;
  Punkte    : array of TPoint;
  AnzPu     : integer;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Left        := 200;
  Top         := 100;
  Width       := 800;
  Height      := 600;
  Color       := clsilver;
 
  Label1            := TLabel.Create(self);
  Label1.Parent     := self;
  Label1.AutoSize   := false;
  Label1.Left       :=  10;
  Label1.Top        :=  20;
  Label1.Width      := 150;
  Label1.Height     :=  25;
  Label1.Color      := clwhite;
 
  Paintbox1            := TPaintbox.Create(self);
  Paintbox1.Parent     := self;
  Paintbox1.Left       :=  10;
  Paintbox1.Top        :=  50;
  Paintbox1.Width      := 780;
  Paintbox1.Height     := 540;
  Paintbox1.OnPaint    := @Paintbox1Paint;
  Paintbox1.OnMouseDown:= @PaintboxMouseDown;
 
  AnzPu :=0;
 
end;
 
procedure TForm1.Paintbox1Paint(Sender: TObject);
begin
 Paintbox1.Canvas.Brush.Color   := clwhite;
 Paintbox1.Canvas.Rectangle(0,0,780,540);
 
 Paintbox1.Canvas.Polyline(Punkte);
 
 
end;
 
procedure TForm1.PaintboxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 //Label1.Caption := 'X: '+inttostr(x)+'Y: '+inttostr(y);
 
 setlength(Punkte,AnzPu+1);
 
 Punkte[AnzPu].X:=x;
 Punkte[AnzPu].Y:=y;
 
 inc(AnzPu);
 
 Paintbox1.Invalidate;
 
 Label1.Caption:='X[0]:'+inttostr(Punkte[0].X)+'Y[0]:'+inttostr(Punkte[0].Y)
end;
 
end.
 
 
Dateianhänge
Test.zip
Polylinie in Paintbox
(6.06 MiB) 117-mal heruntergeladen

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Canvas.Polyline

Beitrag von wp_xyz »

Ich habe noch eine VM mit einem älteren Fedora Linux/gtk2 und Laz 1.7 - das zeigt genau diesen Fehler. Ein Lubuntu mit aktuellem Laz-trunk zeigt den Fehler nicht. Evtl hilft Laz auf v1.8 oder besser gleich auf 2.0.2 aufzurüsten (1.8 ging ja aus 1.7 hervor, könnte also den Fehler noch enthalten), oder ein Update deines Linux.

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Canvas.Polyline

Beitrag von wennerer »

Vielen Dank für deine Geduld!
Ich sollte wahrscheinlich wirklich mal alles erneuern. Bin aber jetzt erstmal froh zu wissen das es nicht an mir liegt. Sonst such ich nämlich noch ein paar Tage den Fehler in meinem Code.
Viele Grüße Bernd

Antworten