TCanvas.Pen und die abgerundeten Ecken

[Meflin]

Moin moin!

Die Canvas.LineTo-Methode hat eine dumme Eigenschaft: sie rundet die Ecken der Linien ab. Bei dünnen Linien merkt man das kaum, bei dickeren wird es aber richtig nervig, wenn man Kanten exakt aufeinander zeichnen will

Also habe ich gesucht und gefunden, wie sich dieses Problem theoretisch lösen lässt, nämlich mit Hilfe der Funktion ExtCreatePen.

Allein - trotz Verwendung selbiger - tut sich rein garnichts, was die Gestaltung der Ecken der Linien betrifft

Mein Code ist Folgender:

Delphi-Quellcode:

const
  SquarePenStyle = PS_Geometric or PS_Solid or PS_EndCap_Square or PS_Join_Miter;
var
  LogBrush: TLOGBRUSH;
  P : HPen;


  LogBrush.lbColor := ColorToRGB(Canvas.Pen.Color);
  LogBrush.lbHatch := 0;
  P := ExtCreatePen(SquarePenStyle, Canvas.Pen.Width, LogBrush, 0, nil);
  Canvas.Pen.Handle := P;

  Canvas.LineTo(X,Y);

Die Ecken bleiben weiterhin abgerundet

Bei der weiteren Recherche bin ich darauf gestoßen, dass es da in Delphi 2005 einen Bug gab:
http://qc.borland.com/wc/qcmain.aspx?d=13225
bzw http://qc.borland.com/wc/qcmain.aspx?d=9661
Der soll aber angeblich gefixt sein, daran kann es also auch nicht liegen

Woran aber dann?

[Meflin]

*Dezent hochhol*

[Sunlight7]

*Dezent Antworte*

Moin!

Dein Code hat auch einen kleinen Bug

Du hast LogBrush.lbStyle nicht initialisiert, deshalb streikt der Aufruf von ExtCreatePen

Entweder Du nullst die Strukturen komplett:
ZeroMemory(@LogBrush, SizeOf(LogBrush)); Oder weist allem einem Wert zu:

Delphi-Quellcode:

LogBrush.lbStyle:=0;
LogBrush.lbColor:=ColorToRGB(Canvas.Pen.Color);
LogBrush.lbHatch:=0;

Dies hat geeckt:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
   var LogBrush:TLOGBRUSH;
begin
   ZeroMemory(@LogBrush, SizeOf(LogBrush));
   LogBrush.lbColor:=ColorToRGB(Canvas.Pen.Color);
   LogBrush.lbHatch:=0;

   DeleteObject(Canvas.Pen.Handle);
   Canvas.Pen.Handle:=ExtCreatePen(PS_Geometric or PS_Solid or PS_EndCap_Square or PS_Join_Miter, 10, LogBrush, 0, nil);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
   Canvas.MoveTo(0, 0);
   Canvas.LineTo(50, 50);
end;

Grüße, Sunlight7

[Meflin]

Wenn ich das in ein leeres Projekt kopiere dann gehts - in meiner eigenen Unit leider nach wie vor nicht

Ich mach mich dann mal auf die Suche

Danke jedenfalls