paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 19:20:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: fix TShape drawing by JoshyFun (issue #0013233)

Browse Source 
git-svn-id: trunk@18838 -
This commit is contained in:
paul 2009-02-27 16:30:43 +00:00
parent a723a0f5eb
commit 2b25d4ddff
1 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/include/shape.inc
View File

@ -37,14 +37,21 @@ var
PaintRect: TRect;
MinSize: Longint;
P: array[0..3] of TPoint;
PenInc, PenDec: Integer;
begin
with Canvas do
begin
Brush.Color := clRed;
FillRect(Rect(0,0,Width,Height));
Pen := FPen;
Brush := FBrush;
PaintRect := Rect(0, 0, Self.Width - 1, Self.Height - 1);
InflateRect(PaintRect, -(Pen.Width div 2), -(Pen.Width div 2));
PenInc := Pen.Width div 2;
PenDec := (Pen.Width - 1) div 2;
PaintRect := Rect(PenInc, PenInc, Self.Width - PenDec, Self.Height - PenDec);
with PaintRect do
begin
MinSize := Min(Right - Left, Bottom - Top);
@ -66,16 +73,16 @@ begin
Ellipse(PaintRect);
stSquaredDiamond, stDiamond:
begin
with PaintRect do
with Self do
begin
P[0].x := Left;
P[0].y := Top + (Bottom - Top) div 2;
P[1].x := Left + (Right - Left) div 2;
P[1].y := Bottom;
P[2].x := Right;
P[0].x := 0;
P[0].y := (Height - 1) div 2;
P[1].x := (Width - 1) div 2;
P[1].y := 0;
P[2].x := Width - 1;
P[2].y := P[0].y;
P[3].x := P[1].x;
P[3].y := Top;
P[3].y := Height - 1;
Polygon(P);
end;
end;