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

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:

Delphi-Quellcode:

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

[Meflin]

:firejump: 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 :)