paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 11:30:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Show user-defined mark shapes in "labels" demo

Browse Source 
git-svn-id: trunk@38677 -
This commit is contained in:
ask 2012-09-16 06:12:13 +00:00
parent 1ff0ad2871
commit befc2df57b
2 changed files with 37 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/tachart/demo/labels/Main.lfm
View File

@ -241,6 +241,7 @@ object Form1: TForm1
'Ellipse' 'Ellipse'
'Rounded corners' 'Rounded corners'
'Rounded sides' 'Rounded sides'
'User-defined'
) )
OnChange = cbShapeChange OnChange = cbShapeChange
Style = csDropDownList Style = csDropDownList

39
components/tachart/demo/labels/Main.pas
View File

@ -5,8 +5,9 @@ unit Main;
interface interface
uses uses
Classes, ComCtrls, ExtCtrls, Spin, StdCtrls, SysUtils, FileUtil, Forms, Classes, ComCtrls, ExtCtrls, Spin, StdCtrls, SysUtils, FileUtil, Forms, Types,
Controls, Graphics, Dialogs, TAGraph, TASeries, TASources, TAChartAxis; Controls, Graphics, Dialogs, TAGraph, TASeries, TASources, TAChartAxis,
TAChartUtils, TATextElements;
type type
@ -35,6 +36,8 @@ type
tsBar: TTabSheet; tsBar: TTabSheet;
procedure cbHideOverlappingChange(Sender: TObject); procedure cbHideOverlappingChange(Sender: TObject);
procedure cbShapeChange(Sender: TObject); procedure cbShapeChange(Sender: TObject);
procedure Chart1BarSeries1MarksGetShape(ASender: TChartTextElement;
const ABoundingBox: TRect; var APolygon: TPointArray);
procedure ChartMultiAxisList1MarkToText(var AText: String; AMark: Double); procedure ChartMultiAxisList1MarkToText(var AText: String; AMark: Double);
procedure seAxisAngleChange(Sender: TObject); procedure seAxisAngleChange(Sender: TObject);
procedure seCalloutAngleChange(Sender: TObject); procedure seCalloutAngleChange(Sender: TObject);
@ -50,7 +53,7 @@ implementation
{$R *.lfm} {$R *.lfm}
uses uses
TATextElements; Math, TAGeometry;
{ TForm1 } { TForm1 }
@ -77,6 +80,36 @@ begin
Chart1BarSeries1.Marks.Shape := s; Chart1BarSeries1.Marks.Shape := s;
ChartMulti.LeftAxis.Marks.Shape := s; ChartMulti.LeftAxis.Marks.Shape := s;
ChartMulti.BottomAxis.Marks.Shape := s; ChartMulti.BottomAxis.Marks.Shape := s;
with Chart1BarSeries1.Marks do
if s = clsUserDefined then
OnGetShape := @Chart1BarSeries1MarksGetShape
else
OnGetShape := nil;
end;
procedure TForm1.Chart1BarSeries1MarksGetShape(
ASender: TChartTextElement; const ABoundingBox: TRect;
var APolygon: TPointArray);
const
N = 24;
var
i: Integer;
a, b, k: Double;
cp: TPoint;
s, c: Extended;
begin
Unused(ASender);
SetLength(APolygon, N);
with ABoundingBox do begin
a := (Right - Left) / 2;
b := (Bottom - Top) / 2;
end;
cp := CenterPoint(ABoundingBox);
for i := 0 to High(APolygon) do begin
SinCos(i * 2 * Pi / N, s, c);
k := (i mod 2) * 0.5 + 1;
APolygon[i] := cp + Point(Round(a * c * k), Round(b * s * k));
end;
end; end;
procedure TForm1.ChartMultiAxisList1MarkToText( procedure TForm1.ChartMultiAxisList1MarkToText(