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

LCL: Add a new Star shape for TShape. Issue #28460, patch from Alexey Torgashin.

Browse Source 
git-svn-id: trunk@49593 -
This commit is contained in:
juha 2015-08-03 23:06:29 +00:00
parent 43f03b0c5c
commit c8458170ec
2 changed files with 52 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/extctrls.pp
View File

@ -251,13 +251,15 @@ type
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle, stSquaredDiamond, stDiamond,
stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown);
stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown,
stStar, stStarDown);
TShape = class(TGraphicControl)
private
FPen: TPen;
FBrush: TBrush;
FShape: TShapeType;
function GetStarAngle(N: Integer; ADown: boolean): Double;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);

50
lcl/include/shape.inc
View File

@ -27,12 +27,21 @@ begin
inherited Destroy;
end;
function TShape.GetStarAngle(N: Integer; ADown: boolean): Double;
begin
Result := pi/5 * N + pi/2 * IfThen(ADown, -1, 1);
end;
procedure TShape.Paint;
var
PaintRect: TRect;
MinSize: Longint;
P: array[0..3] of TPoint;
PStar: array[0..10] of TPoint;
PenInc, PenDec: Integer;
RadiusBig, RadiusBig2, RadiusSm, i: Integer;
PCenter: TPoint;
Alfa: Double;
begin
with Canvas do
begin
@ -142,7 +151,46 @@ begin
Polygon(P);
end;
end;
end;
stStar,
stStarDown:
begin
with Self do
begin
//radius if star scaled by height
RadiusBig := Trunc((Height-Pen.Width) / (1+cos(pi/5)));
//radius if star scaled by width
RadiusBig2 := Trunc((Width-Pen.Width) / (2*sin(pi*2/5)));
if RadiusBig<=RadiusBig2 then
begin
if FShape=stStar then
PCenter.Y := RadiusBig+PenDec
else
PCenter.Y := Height-RadiusBig-PenDec;
end
else
begin
RadiusBig := RadiusBig2;
PCenter.Y := Height div 2;
end;
PCenter.X := Width div 2;
RadiusSm := RadiusBig * 57 div 150;
for i := 0 to 4 do
begin
Alfa := GetStarAngle(i*2, FShape=stStarDown);
PStar[i*2].x := PCenter.X + Round(RadiusBig*cos(Alfa));
PStar[i*2].y := PCenter.Y - Round(RadiusBig*sin(Alfa));
Alfa:= GetStarAngle(i*2+1, FShape=stStarDown);
PStar[i*2+1].x := PCenter.X + Round(RadiusSm*cos(Alfa));
PStar[i*2+1].y := PCenter.Y - Round(RadiusSm*sin(Alfa));
end;
PStar[10] := PStar[0];
Polygon(PStar);
end;
end;
end;
end;
// to fire OnPaint event
inherited Paint;