paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 15:59:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TShape, add triangles with left / right / down directions. Issue #28429, patch from Alexey Torgashin.

Browse Source 
git-svn-id: trunk@49584 -
This commit is contained in:
juha 2015-08-01 08:49:05 +00:00
parent 22ea26d2cc
commit e8bd482fe1
2 changed files with 48 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/extctrls.pp
View File

@ -250,7 +250,8 @@ type
{ TShape } { TShape }
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare, TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle, stSquaredDiamond, stDiamond, stTriangle); stEllipse, stCircle, stSquaredDiamond, stDiamond,
stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown);
TShape = class(TGraphicControl) TShape = class(TGraphicControl)
private private

47
lcl/include/shape.inc
View File

@ -97,7 +97,52 @@ begin
Polygon(P); Polygon(P);
end; end;
end; end;
end; stTriangleDown:
begin
with Self do
begin
P[0].x := (Width - 1) div 2;
P[0].y := Height - PenInc - 1;
P[1].x := Width - PenInc - 1;
P[1].y := PenInc;
P[2].x := PenInc;
P[2].y := PenInc;
P[3].x := P[0].x;
P[3].y := P[0].y;
Polygon(P);
end;
end;
stTriangleLeft:
begin
with Self do
begin
P[0].x := PenInc;
P[0].y := Height div 2;
P[1].x := Width - PenInc - 1;
P[1].y := PenInc;
P[2].x := Width - PenInc - 1;
P[2].y := Height - PenInc - 1;
P[3].x := P[0].x;
P[3].y := P[0].y;
Polygon(P);
end;
end;
stTriangleRight:
begin
with Self do
begin
P[0].x := Width - PenInc - 1;
P[0].y := Height div 2;
P[1].x := PenInc;
P[1].y := PenInc;
P[2].x := PenInc;
P[2].y := Height - PenInc - 1;
P[3].x := P[0].x;
P[3].y := P[0].y;
Polygon(P);
end;
end;
end;
end; end;
// to fire OnPaint event // to fire OnPaint event
inherited Paint; inherited Paint;