mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 19:29:34 +02:00
LCL: TShape, add triangles with left / right / down directions. Issue #28429, patch from Alexey Torgashin.
git-svn-id: trunk@49584 -
This commit is contained in:
parent
22ea26d2cc
commit
e8bd482fe1
@ -250,7 +250,8 @@ type
|
||||
{ TShape }
|
||||
|
||||
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
|
||||
stEllipse, stCircle, stSquaredDiamond, stDiamond, stTriangle);
|
||||
stEllipse, stCircle, stSquaredDiamond, stDiamond,
|
||||
stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown);
|
||||
|
||||
TShape = class(TGraphicControl)
|
||||
private
|
||||
|
@ -97,7 +97,52 @@ begin
|
||||
Polygon(P);
|
||||
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;
|
||||
// to fire OnPaint event
|
||||
inherited Paint;
|
||||
|
Loading…
Reference in New Issue
Block a user