mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-05 18:18:15 +02:00
TAChart: Implement multi-level data-point labels. Update barshapes_demo.
This commit is contained in:
parent
511ccf9bc3
commit
40f705da45
@ -1,5 +1,5 @@
|
||||
{ "barseriesshapes" : {
|
||||
"Category" : "TAChart",
|
||||
"Keywords" : ["TAChart", "bar chart", "shapes"],
|
||||
"Description" : "Demonstrates the different shapes that can be used to draw the bars in a bar chart."}
|
||||
"Keywords" : ["TAChart", "bar chart", "shapes", "stacked", "labels"],
|
||||
"Description" : "Demonstrates the different shapes that can be used to draw the bars in a bar chart. Additionally, it is shown how stacked bars can display individual data point labels."}
|
||||
}
|
@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions BuildModesCount="1">
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
@ -14,7 +14,7 @@
|
||||
</XPManifest>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item1 Name="default" Default="True"/>
|
||||
<Item Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
@ -22,30 +22,29 @@
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="TAChartLazarusPkg"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="barshapes_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="BarShapes_Demo"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit1>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -59,6 +58,9 @@
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
@ -67,16 +69,16 @@
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
|
@ -14,6 +14,7 @@ uses
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Title:='BarShapes_Demo';
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
|
@ -1,17 +1,18 @@
|
||||
object Form1: TForm1
|
||||
Left = 332
|
||||
Height = 370
|
||||
Height = 384
|
||||
Top = 127
|
||||
Width = 495
|
||||
Width = 633
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 370
|
||||
ClientWidth = 495
|
||||
LCLVersion = '2.3.0.0'
|
||||
ClientHeight = 384
|
||||
ClientWidth = 633
|
||||
LCLVersion = '3.99.0.0'
|
||||
OnCreate = FormCreate
|
||||
object Chart1: TChart
|
||||
Left = 0
|
||||
Height = 335
|
||||
Height = 349
|
||||
Top = 0
|
||||
Width = 495
|
||||
Width = 633
|
||||
AxisList = <
|
||||
item
|
||||
Grid.Color = clSilver
|
||||
@ -32,6 +33,7 @@ object Form1: TForm1
|
||||
BackColor = clWhite
|
||||
Foot.Brush.Color = clBtnFace
|
||||
Foot.Font.Color = clBlue
|
||||
Legend.Visible = True
|
||||
Title.Brush.Color = clBtnFace
|
||||
Title.Font.Color = clBlue
|
||||
Title.Text.Strings = (
|
||||
@ -39,36 +41,39 @@ object Form1: TForm1
|
||||
)
|
||||
Align = alClient
|
||||
object BarSeries: TBarSeries
|
||||
Legend.Multiplicity = lmStyle
|
||||
AxisIndexX = 1
|
||||
AxisIndexY = 0
|
||||
BarBrush.Color = clRed
|
||||
Depth = 20
|
||||
DepthBrightnessDelta = -32
|
||||
Source = RandomChartSource1
|
||||
Marks.LabelFont.Color = clWhite
|
||||
Marks.Visible = False
|
||||
Marks.LabelBrush.Color = clOlive
|
||||
Marks.LinkPen.Color = clGray
|
||||
Styles = ChartStyles1
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 35
|
||||
Top = 335
|
||||
Width = 495
|
||||
Top = 349
|
||||
Width = 633
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 35
|
||||
ClientWidth = 495
|
||||
ClientWidth = 633
|
||||
TabOrder = 1
|
||||
object lblShape: TLabel
|
||||
AnchorSideLeft.Control = cb3D
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 52
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 32
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Shape'
|
||||
end
|
||||
@ -76,7 +81,7 @@ object Form1: TForm1
|
||||
AnchorSideLeft.Control = lblShape
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 90
|
||||
Left = 44
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 164
|
||||
@ -92,68 +97,54 @@ object Form1: TForm1
|
||||
'pyramid'
|
||||
'conical'
|
||||
)
|
||||
OnChange = cmbShapeChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
Text = 'rectangular box'
|
||||
OnChange = cmbShapeChange
|
||||
end
|
||||
object cb3D: TCheckBox
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 34
|
||||
BorderSpacing.Left = 6
|
||||
Caption = '3D'
|
||||
Checked = True
|
||||
OnChange = cb3DChange
|
||||
State = cbChecked
|
||||
TabOrder = 1
|
||||
end
|
||||
object lblLevels: TLabel
|
||||
AnchorSideLeft.Control = cmbShape
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 266
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 32
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'Levels'
|
||||
end
|
||||
object seLevels: TSpinEdit
|
||||
AnchorSideLeft.Control = lblLevels
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 304
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 42
|
||||
Alignment = taRightJustify
|
||||
BorderSpacing.Left = 6
|
||||
MaxValue = 5
|
||||
MinValue = 1
|
||||
OnChange = seLevelsChange
|
||||
TabOrder = 2
|
||||
Value = 3
|
||||
end
|
||||
object cbRotated: TCheckBox
|
||||
AnchorSideLeft.Control = seLevels
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 358
|
||||
Left = 220
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 61
|
||||
Width = 32
|
||||
BorderSpacing.Left = 12
|
||||
Caption = '3D'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 1
|
||||
OnChange = cb3DChange
|
||||
end
|
||||
object cbRotated: TCheckBox
|
||||
AnchorSideLeft.Control = cb3D
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = cmbShape
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 264
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 59
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'Rotated'
|
||||
TabOrder = 2
|
||||
OnChange = cbRotatedChange
|
||||
end
|
||||
object cbShowLabels: TCheckBox
|
||||
AnchorSideLeft.Control = cbRotated
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 335
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 80
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'Show labels'
|
||||
TabOrder = 3
|
||||
OnChange = cbShowLabelsChange
|
||||
end
|
||||
end
|
||||
object RandomChartSource1: TRandomChartSource
|
||||
@ -169,18 +160,18 @@ object Form1: TForm1
|
||||
Styles = <
|
||||
item
|
||||
Brush.Color = clRed
|
||||
Text = 'RED'
|
||||
UseFont = False
|
||||
end
|
||||
item
|
||||
Brush.Color = clYellow
|
||||
Text = 'YELLOW'
|
||||
UseFont = False
|
||||
end
|
||||
item
|
||||
Brush.Color = clBlue
|
||||
end
|
||||
item
|
||||
Brush.Color = clTeal
|
||||
end
|
||||
item
|
||||
Brush.Color = clFuchsia
|
||||
Text = 'BLUE'
|
||||
UseFont = False
|
||||
end>
|
||||
Left = 232
|
||||
Top = 79
|
||||
|
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
|
||||
Spin, TAGraph, TASeries, TASources, TAStyles;
|
||||
Spin, TAGraph, TASeries, TASources, TAStyles, TAChartUtils;
|
||||
|
||||
type
|
||||
|
||||
@ -18,16 +18,16 @@ type
|
||||
cb3D: TCheckBox;
|
||||
ChartStyles1: TChartStyles;
|
||||
cbRotated: TCheckBox;
|
||||
cbShowLabels: TCheckBox;
|
||||
cmbShape: TComboBox;
|
||||
lblLevels: TLabel;
|
||||
lblShape: TLabel;
|
||||
Panel1: TPanel;
|
||||
RandomChartSource1: TRandomChartSource;
|
||||
seLevels: TSpinEdit;
|
||||
procedure cb3DChange(Sender: TObject);
|
||||
procedure cbRotatedChange(Sender: TObject);
|
||||
procedure cbShowLabelsChange(Sender: TObject);
|
||||
procedure cmbShapeChange(Sender: TObject);
|
||||
procedure seLevelsChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
|
||||
public
|
||||
@ -62,15 +62,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.cbShowLabelsChange(Sender: TObject);
|
||||
begin
|
||||
BarSeries.Marks.Visible := cbShowLabels.Checked;
|
||||
end;
|
||||
|
||||
procedure TForm1.cmbShapeChange(Sender: TObject);
|
||||
begin
|
||||
BarSeries.BarShape := TBarShape(cmbShape.ItemIndex);
|
||||
cb3DChange(nil);
|
||||
end;
|
||||
|
||||
procedure TForm1.seLevelsChange(Sender: TObject);
|
||||
function RandomString(ALength: Integer): String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
RandomChartSource1.YCount := seLevels.Value;
|
||||
SetLength(Result, ALength);
|
||||
Result[1] := Char(ord('A') + Random(26));
|
||||
for i := 2 to ALength do
|
||||
Result[i] := Char(ord('a') + Random(26));
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
i, j: Integer;
|
||||
s: String;
|
||||
begin
|
||||
RandSeed := 1;
|
||||
BarSeries.Marks.Style := smsLabel;
|
||||
BarSeries.Marks.YIndex := -1;
|
||||
BarSeries.ListSource.YCount := 3;
|
||||
BarSeries.ListSource.LabelSeparator:= ';';
|
||||
for i := 0 to 5 do
|
||||
begin
|
||||
s := RandomString(1 + Random(4));
|
||||
for j := 2 to BarSeries.ListSource.YCount do
|
||||
s := s + ';' + RandomString(1 + Random(4));
|
||||
BarSeries.AddXY(i, 20+Random*100, [20+Random*100, 20+Random*100], s);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -7,7 +7,7 @@ object Form1: TForm1
|
||||
ClientHeight = 430
|
||||
ClientWidth = 624
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '2.3.0.0'
|
||||
LCLVersion = '3.99.0.0'
|
||||
object pcMain: TPageControl
|
||||
Left = 0
|
||||
Height = 355
|
||||
@ -143,12 +143,12 @@ object Form1: TForm1
|
||||
Left = 436
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 144
|
||||
Width = 142
|
||||
BorderSpacing.Left = 16
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Hide overlapping labels'
|
||||
OnChange = cbHideOverlappingChange
|
||||
TabOrder = 0
|
||||
OnChange = cbHideOverlappingChange
|
||||
end
|
||||
object gbAngles: TGroupBox
|
||||
Left = 8
|
||||
@ -176,8 +176,8 @@ object Form1: TForm1
|
||||
Increment = 5
|
||||
MaxValue = 360
|
||||
MinValue = -360
|
||||
OnChange = seAxisAngleChange
|
||||
TabOrder = 0
|
||||
OnChange = seAxisAngleChange
|
||||
end
|
||||
object lblAxisAngle: TLabel
|
||||
AnchorSideLeft.Control = gbAngles
|
||||
@ -216,8 +216,8 @@ object Form1: TForm1
|
||||
Increment = 5
|
||||
MaxValue = 360
|
||||
MinValue = -360
|
||||
OnChange = seSeriesAngleChange
|
||||
TabOrder = 1
|
||||
OnChange = seSeriesAngleChange
|
||||
end
|
||||
object lblTitleAngle: TLabel
|
||||
AnchorSideLeft.Control = seSeriesAngle
|
||||
@ -245,8 +245,8 @@ object Form1: TForm1
|
||||
Increment = 5
|
||||
MaxValue = 360
|
||||
MinValue = -360
|
||||
OnChange = seTitleAngleChange
|
||||
TabOrder = 2
|
||||
OnChange = seTitleAngleChange
|
||||
end
|
||||
object seCalloutAngle: TSpinEdit
|
||||
AnchorSideLeft.Control = lblCalloutAngle
|
||||
@ -262,8 +262,8 @@ object Form1: TForm1
|
||||
BorderSpacing.Bottom = 8
|
||||
Increment = 5
|
||||
MaxValue = 120
|
||||
OnChange = seCalloutAngleChange
|
||||
TabOrder = 3
|
||||
OnChange = seCalloutAngleChange
|
||||
end
|
||||
object lblCalloutAngle: TLabel
|
||||
AnchorSideLeft.Control = seTitleAngle
|
||||
@ -297,10 +297,10 @@ object Form1: TForm1
|
||||
'Rounded sides'
|
||||
'User-defined'
|
||||
)
|
||||
OnChange = cbShapeChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
Text = 'Rectangle'
|
||||
OnChange = cbShapeChange
|
||||
end
|
||||
end
|
||||
object RandomChartSource1: TRandomChartSource
|
||||
|
@ -95,6 +95,7 @@ type
|
||||
XList: TDoubleDynArray;
|
||||
YList: TDoubleDynArray;
|
||||
procedure CopyFrom(AItem: PChartDataItem);
|
||||
function GetText(AIndex: Integer; ALabelSeparator: Char): String;
|
||||
function GetX(AIndex: Integer): Double;
|
||||
function GetY(AIndex: Integer): Double;
|
||||
procedure SetX(AIndex: Integer; const AValue: Double);
|
||||
@ -188,6 +189,7 @@ type
|
||||
TCustomChartSource = class(TBasicChartSource)
|
||||
strict private
|
||||
FErrorBarData: array[0..1] of TChartErrorBarData;
|
||||
FLabelSeparator: Char;
|
||||
function GetErrorBarData(AIndex: Integer): TChartErrorBarData;
|
||||
function IsErrorBarDataStored(AIndex: Integer): Boolean;
|
||||
procedure SetErrorBarData(AIndex: Integer; AValue: TChartErrorBarData);
|
||||
@ -225,6 +227,7 @@ type
|
||||
procedure SetSortIndex(AValue: Cardinal); virtual;
|
||||
procedure SetXCount(AValue: Cardinal); virtual; abstract;
|
||||
procedure SetYCount(AValue: Cardinal); virtual;
|
||||
property LabelSeparator: Char read FLabelSeparator write FLabelSeparator default '|';
|
||||
property XErrorBarData: TChartErrorBarData index 0 read GetErrorBarData
|
||||
write SetErrorBarData stored IsErrorBarDataStored;
|
||||
property YErrorBarData: TChartErrorBarData index 1 read GetErrorBarData
|
||||
@ -554,6 +557,18 @@ begin
|
||||
Color := AItem^.Color;
|
||||
end;
|
||||
|
||||
function TChartDataItem.GetText(AIndex: Integer; ALabelSeparator: Char): String;
|
||||
var
|
||||
sa: TStringArray;
|
||||
begin
|
||||
AIndex := EnsureRange(AIndex, 0, Length(YList));
|
||||
sa := Text.Split(ALabelSeparator);
|
||||
if InRange(AIndex, 0, High(sa)) then
|
||||
Result := sa[AIndex]
|
||||
else
|
||||
Result := Text;
|
||||
end;
|
||||
|
||||
function TChartDataItem.GetX(AIndex: Integer): Double;
|
||||
begin
|
||||
AIndex := EnsureRange(AIndex, 0, Length(XList));
|
||||
@ -1013,6 +1028,7 @@ var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FLabelSeparator := '|';
|
||||
FSortBy := sbX;
|
||||
FSortDir := sdAscending;
|
||||
FSortIndex := 0;
|
||||
@ -1236,7 +1252,7 @@ function TCustomChartSource.FormatItem(
|
||||
const AFormat: String; AIndex, AYIndex: Integer): String;
|
||||
begin
|
||||
with Item[AIndex]^ do
|
||||
Result := FormatItemXYText(AFormat, Math.IfThen(XCount > 0, X, Double(AIndex)), GetY(AYIndex), Text);
|
||||
Result := FormatItemXYText(AFormat, Math.IfThen(XCount > 0, X, Double(AIndex)), GetY(AYIndex), GetText(AYIndex, FLabelSeparator));
|
||||
end;
|
||||
|
||||
function TCustomChartSource.FormatItemXYText(
|
||||
|
@ -64,6 +64,7 @@ type
|
||||
property UseSortedAutoDetection;
|
||||
published
|
||||
property DataPoints: TStrings read FDataPoints write SetDataPoints;
|
||||
property LabelSeparator;
|
||||
property XCount;
|
||||
property XErrorBarData;
|
||||
property YCount;
|
||||
@ -230,6 +231,7 @@ type
|
||||
property PointsNumber: Integer
|
||||
read FPointsNumber write SetPointsNumber default 0;
|
||||
property Sorted: Boolean read FSorted write FSorted default false;
|
||||
property LabelSeparator;
|
||||
property XCount;
|
||||
property XErrorBarData;
|
||||
property YCount;
|
||||
|
Loading…
Reference in New Issue
Block a user