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

components/tachart/demo/barseriesshapes/barseriesshapes.ex-meta

@@ -1,5 +1,5 @@
 { "barseriesshapes" : {
    "Category" : "TAChart",
-   "Keywords" : ["TAChart", "bar chart", "shapes"],
+   "Keywords" : ["TAChart", "bar chart", "shapes", "stacked", "labels"],
-   "Description" : "Demonstrates the different shapes that can be used to draw the bars in a bar chart."}
+   "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."}
 }

components/tachart/demo/barseriesshapes/barshapes_demo.lpi

@@ -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">
+    <RequiredPackages>
-      <Item1>
+      <Item>
         <PackageName Value="TAChartLazarusPkg"/>
-      </Item1>
+      </Item>
-      <Item2>
+      <Item>
         <PackageName Value="LCL"/>
-      </Item2>
+      </Item>
     </RequiredPackages>
-    <Units Count="2">
+    <Units>
-      <Unit0>
+      <Unit>
         <Filename Value="barshapes_demo.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="BarShapes_Demo"/>
-      </Unit0>
+      </Unit>
-      <Unit1>
+      <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">
+    <Exceptions>
-      <Item1>
+      <Item>
         <Name Value="EAbort"/>
-      </Item1>
+      </Item>
-      <Item2>
+      <Item>
         <Name Value="ECodetoolError"/>
-      </Item2>
+      </Item>
-      <Item3>
+      <Item>
         <Name Value="EFOpenError"/>
-      </Item3>
+      </Item>
     </Exceptions>
   </Debugging>
 </CONFIG>

components/tachart/demo/barseriesshapes/barshapes_demo.lpr

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

components/tachart/demo/barseriesshapes/main.lfm

@@ -1,17 +1,18 @@
 object Form1: TForm1
   Left = 332
-  Height = 370
+  Height = 384
   Top = 127
-  Width = 495
+  Width = 633
   Caption = 'Form1'
-  ClientHeight = 370
+  ClientHeight = 384
-  ClientWidth = 495
+  ClientWidth = 633
-  LCLVersion = '2.3.0.0'
+  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
+    Top = 349
-    Width = 495
+    Width = 633
     Align = alBottom
     AutoSize = True
     BevelOuter = bvNone
     ClientHeight = 35
-    ClientWidth = 495
+    ClientWidth = 633
     TabOrder = 1
     object lblShape: TLabel
-      AnchorSideLeft.Control = cb3D
+      AnchorSideLeft.Control = Panel1
-      AnchorSideLeft.Side = asrBottom
       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
+      Left = 220
-      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
       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    
+        Text = 'BLUE'
-      item
+        UseFont = False
-        Brush.Color = clTeal
-      end    
-      item
-        Brush.Color = clFuchsia
       end>
     Left = 232
     Top = 79

components/tachart/demo/barseriesshapes/main.pas

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

components/tachart/demo/labels/Main.lfm

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

components/tachart/tacustomsource.pas

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

components/tachart/tasources.pas

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