TAChart: Implement multi-level data-point labels. Update barshapes_demo.

This commit is contained in:
wp_xyz 2024-01-26 13:03:49 +01:00
parent 511ccf9bc3
commit 40f705da45
8 changed files with 147 additions and 106 deletions

View File

@ -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."}
}

View File

@ -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>

View File

@ -14,6 +14,7 @@ uses
begin
RequireDerivedFormResource:=True;
Application.Title:='BarShapes_Demo';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -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(

View File

@ -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;