TAChart: Add property TBarShape to TBarSeries to allow painting of bars as cylinders, pyramids, prisms etc. Add related demo.

git-svn-id: trunk@60762 -
2025-08-11 18:16:06 +02:00 · 2019-03-24 15:57:28 +00:00 · 2019-03-24 15:57:28 +00:00 · a4166ee45d
commit a4166ee45d
parent eab7d57403
8 changed files with 520 additions and 23 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -5034,6 +5034,10 @@ components/tachart/demo/axistransf/axistransfdemo.lpi svneol=native#text/plain
 components/tachart/demo/axistransf/axistransfdemo.lpr svneol=native#text/pascal
 components/tachart/demo/axistransf/main.lfm svneol=native#text/plain
 components/tachart/demo/axistransf/main.pas svneol=native#text/pascal
+components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi svneol=native#text/xml
+components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr svneol=native#text/pascal
+components/tachart/demo/barseriesshapes/main.lfm svneol=native#text/plain
+components/tachart/demo/barseriesshapes/main.pas svneol=native#text/pascal
 components/tachart/demo/barseriestools/barseriestools.lpi svneol=native#text/plain
 components/tachart/demo/barseriestools/barseriestools.lpr svneol=native#text/plain
 components/tachart/demo/barseriestools/main.lfm svneol=native#text/plain
--- a/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi
+++ b/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi
@ -0,0 +1,81 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions BuildModesCount="1">
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="BarShapes_Demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes>
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="TAChartLazarusPkg"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="BarShapes_Demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Main"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="BarShapes_Demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr
+++ b/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr
@ -0,0 +1,22 @@
+program BarShapes_Demo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/components/tachart/demo/barseriesshapes/main.lfm
+++ b/components/tachart/demo/barseriesshapes/main.lfm
@ -0,0 +1,175 @@
+object Form1: TForm1
+  Left = 332
+  Height = 278
+  Top = 127
+  Width = 535
+  Caption = 'Form1'
+  ClientHeight = 278
+  ClientWidth = 535
+  LCLVersion = '2.1.0.0'
+  object Chart1: TChart
+    Left = 0
+    Height = 243
+    Top = 0
+    Width = 535
+    AxisList = <    
+      item
+        Marks.LabelBrush.Style = bsClear
+        Minors = <>
+        Title.LabelFont.Orientation = 900
+        Title.LabelBrush.Style = bsClear
+      end    
+      item
+        Intervals.MaxLength = 150
+        Intervals.MinLength = 50
+        Alignment = calBottom
+        Marks.LabelBrush.Style = bsClear
+        Minors = <>
+        Title.LabelBrush.Style = bsClear
+      end>
+    Foot.Brush.Color = clBtnFace
+    Foot.Font.Color = clBlue
+    Margins.Top = 24
+    Margins.Right = 24
+    Title.Brush.Color = clBtnFace
+    Title.Font.Color = clBlue
+    Title.Text.Strings = (
+      'TAChart'
+    )
+    Align = alClient
+    object BarSeries: TBarSeries
+      BarBrush.Color = clRed
+      Depth = 20
+      DepthBrightnessDelta = -32
+      Source = RandomChartSource1
+      Styles = ChartStyles1
+    end
+  end
+  object Panel1: TPanel
+    Left = 0
+    Height = 35
+    Top = 243
+    Width = 535
+    Align = alBottom
+    AutoSize = True
+    BevelOuter = bvNone
+    ClientHeight = 35
+    ClientWidth = 535
+    TabOrder = 1
+    object lblShape: TLabel
+      AnchorSideLeft.Control = cb3D
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = cmbShape
+      AnchorSideTop.Side = asrCenter
+      Left = 52
+      Height = 15
+      Top = 10
+      Width = 32
+      BorderSpacing.Left = 12
+      BorderSpacing.Right = 6
+      Caption = 'Shape'
+      ParentColor = False
+    end
+    object cmbShape: TComboBox
+      AnchorSideLeft.Control = lblShape
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      Left = 90
+      Height = 23
+      Top = 6
+      Width = 164
+      BorderSpacing.Left = 6
+      BorderSpacing.Top = 6
+      BorderSpacing.Bottom = 6
+      ItemHeight = 15
+      ItemIndex = 0
+      Items.Strings = (
+        'rectangular box'
+        'cylinder'
+        'hexagonal prism'
+        'pyramid'
+        'conical'
+      )
+      OnChange = cmbShapeChange
+      Style = csDropDownList
+      TabOrder = 0
+      Text = 'rectangular box'
+    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'
+      ParentColor = False
+    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
+  end
+  object RandomChartSource1: TRandomChartSource
+    PointsNumber = 6
+    RandSeed = 1050736283
+    XMax = 5
+    XMin = 0
+    YCount = 3
+    YMax = 100
+    YMin = 0
+    left = 136
+    top = 81
+  end
+  object ChartStyles1: TChartStyles
+    Styles = <    
+      item
+        Brush.Color = clRed
+      end    
+      item
+        Brush.Color = clYellow
+      end    
+      item
+        Brush.Color = clBlue
+      end    
+      item
+        Brush.Color = clTeal
+      end    
+      item
+        Brush.Color = clFuchsia
+      end>
+    left = 232
+    top = 79
+  end
+end
--- a/components/tachart/demo/barseriesshapes/main.pas
+++ b/components/tachart/demo/barseriesshapes/main.pas
@ -0,0 +1,69 @@
+unit Main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  Spin, TAGraph, TASeries, TASources, TAStyles;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Chart1: TChart;
+    BarSeries: TBarSeries;
+    cb3D: TCheckBox;
+    ChartStyles1: TChartStyles;
+    cmbShape: TComboBox;
+    lblLevels: TLabel;
+    lblShape: TLabel;
+    Panel1: TPanel;
+    RandomChartSource1: TRandomChartSource;
+    seLevels: TSpinEdit;
+    procedure cb3DChange(Sender: TObject);
+    procedure cmbShapeChange(Sender: TObject);
+    procedure seLevelsChange(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+uses
+  Math;
+
+{ TForm1 }
+
+procedure TForm1.cb3DChange(Sender: TObject);
+begin
+  if cb3D.Checked then
+    BarSeries.Depth := 20
+  else
+    BarSeries.Depth := 0;
+  Chart1.Margins.Top := 4 + Barseries.Depth;
+  Chart1.Margins.Right := 4 + IfThen(BarSeries.BarShape in [bsRectangular, bsPyramid], Barseries.Depth, 0);
+end;
+
+procedure TForm1.cmbShapeChange(Sender: TObject);
+begin
+  BarSeries.BarShape := TBarShape(cmbShape.ItemIndex);
+  cb3DChange(nil);
+end;
+
+procedure TForm1.seLevelsChange(Sender: TObject);
+begin
+  RandomChartSource1.YCount := seLevels.Value;
+end;
+
+end.
+
--- a/components/tachart/fpdoc/tagraph.xml
+++ b/components/tachart/fpdoc/tagraph.xml
@ -101,14 +101,12 @@ use
      </element>
      <element name="TChart.Margins">
        <short>Margins around the chart sides in default extent, in pixels.</short>
-        <seealso>
-          <link id="TChart.BorderSpacing">BorderSpacing</link>
-          <link id="TChart.ExpandPercentage">ExpandPercentage</link>
-          <link id="TChart.Extent">Extent</link>
+        <seealso><link id="TChart.BorderSpacing">BorderSpacing</link><link id="TChart.ExpandPercentage">ExpandPercentage</link><link id="TChart.Extent">Extent</link>
        </seealso>
        <descr>Note that the margins set by this property have effect only on the default extent.
 Use <link id="TChart.BorderSpacing">BorderSpacing</link> property to set margins
-independently of zoom level.</descr>
+independently of zoom level.
+</descr>
      </element>
      <element name="TChart.Extent">
        <short>Manual overrides for the chart extent borders.</short>
--- a/components/tachart/tacustomseries.pas
+++ b/components/tachart/tacustomseries.pas
@ -99,7 +99,7 @@ type
    function GetAxisX: TChartAxis;
    function GetAxisY: TChartAxis;
    function GetAxisBounds(AAxis: TChartAxis; out AMin, AMax: Double): Boolean; override;
-    function GetDepthColor(AColor: Integer): Integer; virtual;
+    function GetDepthColor(AColor: Integer; Opposite: boolean = false): Integer; virtual;
    function GetGraphBounds: TDoubleRect; override;
    function GraphToAxis(APoint: TDoublePoint): TDoublePoint;
    function GraphToAxisX(AX: Double): Double; override;
@ -363,7 +363,7 @@ type
 implementation

 uses
-  Math, PropEdits, StrUtils, LResources, Types,
+  Math, PropEdits, StrUtils, LResources, Types, GraphUtil,
  TAChartStrConsts, TAGeometry, TAMath;

 function CreateLazIntfImage(
@ -473,16 +473,16 @@ begin
    Result := FChart.LeftAxis;
 end;

-function TCustomChartSeries.GetDepthColor(AColor: Integer): Integer;
-type
-  TBytes = packed array [1..4] of Byte;
+function TCustomChartSeries.GetDepthColor(AColor: Integer;
+  Opposite: Boolean = false): Integer;
 var
-  c: TBytes absolute AColor;
-  r: TBytes absolute Result;
-  i: Integer;
+  h, l, s: Byte;
 begin
-  for i := 1 to 4 do
-    r[i] := EnsureRange(c[i] + FDepthBrightnessDelta, 0, 255);
+  ColorToHLS(AColor, h, l, s);
+  if Opposite then
+    Result := HLSToColor(h, EnsureRange(Integer(l) - FDepthBrightnessDelta, 0, 255), s)
+  else
+    Result := HLSToColor(h, EnsureRange(Integer(l) + FDepthBrightnessDelta, 0, 255), s);
 end;

 function TCustomChartSeries.GetGraphBounds: TDoubleRect;
--- a/components/tachart/taseries.pas
+++ b/components/tachart/taseries.pas
@ -32,6 +32,8 @@ const
 type
  EBarError = class(EChartError);

+  TBarShape = (bsRectangular, bsCylindrical, bsHexPrism, bsPyramid, bsConical);
+
  TBarWidthStyle = (bwPercent, bwPercentMin);

  TBarSeries = class;
@ -52,6 +54,7 @@ type
    FBarBrush: TBrush;
    FBarOffsetPercent: Integer;
    FBarPen: TPen;
+    FBarShape: TBarShape;
    FBarWidthPercent: Integer;
    FBarWidthStyle: TBarWidthStyle;
    FOnBeforeDrawBar: TBeforeDrawBarEvent;
@ -63,6 +66,7 @@ type
    procedure SetBarBrush(Value: TBrush);
    procedure SetBarOffsetPercent(AValue: Integer);
    procedure SetBarPen(Value: TPen);
+    procedure SetBarShape(AValue: TBarShape);
    procedure SetBarWidthPercent(Value: Integer);
    procedure SetBarWidthStyle(AValue: TBarWidthStyle);
    procedure SetOnBeforeDrawBar(AValue: TBeforeDrawBarEvent);
@ -97,6 +101,7 @@ type
    property BarOffsetPercent: Integer
      read FBarOffsetPercent write SetBarOffsetPercent default 0;
    property BarPen: TPen read FBarPen write SetBarPen;
+    property BarShape: TBarShape read FBarshape write SetBarShape default bsRectangular;
    property BarWidthPercent: Integer
      read FBarWidthPercent write SetBarWidthPercent default DEF_BAR_WIDTH_PERCENT;
    property BarWidthStyle: TBarWidthStyle
@ -1141,6 +1146,7 @@ procedure TBarSeries.Draw(ADrawer: IChartDrawer);
 var
  pointIndex, stackIndex: Integer;
  scaled_depth: Integer;
+  scaled_depth2: Integer;

  procedure DrawBar(const AR: TRect);
  var
@ -1148,6 +1154,9 @@ var
    defaultDrawing: Boolean = true;
    c: TColor;
    ic: IChartTCanvasDrawer;
+    pts: TPointArray;
+    a, b, cx, cy, factor: Double;
+    h: Integer;
  begin
    ADrawer.Pen := BarPen;
    ADrawer.Brush := BarBrush;
@ -1171,14 +1180,145 @@ var
      OnBeforeDrawBar(Self, ic.Canvas, AR, pointIndex, stackIndex, defaultDrawing);
    if not defaultDrawing then exit;

-    ADrawer.Rectangle(AR);
-
-    if Depth = 0 then exit;
-
-    ADrawer.BrushColor := GetDepthColor(ADrawer.BrushColor);
-    ADrawer.DrawLineDepth(AR.Left, AR.Top, AR.Right - 1, AR.Top, scaled_depth);
-    ADrawer.DrawLineDepth(
-      AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, scaled_depth);
+    case FBarShape of
+      bsRectangular:
+        begin
+          ADrawer.Rectangle(AR);
+          if Depth > 0 then begin
+            c := ADrawer.BrushColor;
+            ADrawer.BrushColor := GetDepthColor(c, true);
+            ADrawer.DrawLineDepth(
+              AR.Left, AR.Top, AR.Right - 1, AR.Top, scaled_depth);
+            ADrawer.BrushColor := GetDepthColor(c, false);
+            ADrawer.DrawLineDepth(
+              AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, scaled_depth);
+          end;
+        end;
+      bsPyramid:
+        begin
+          c := ADrawer.BrushColor;
+          SetLength(pts, 3);
+          if Depth = 0 then begin
+            pts[0] := Point(AR.Left, AR.Bottom);
+            pts[1] := Point(AR.Right, AR.Bottom);
+            pts[2] := Point((AR.Left + AR.Right) div 2, AR.Top);
+            ADrawer.Polygon(pts, 0, 3);
+          end else begin
+            pts[0] := Point(AR.Left + scaled_depth, AR.Bottom - scaled_depth);
+            pts[1] := Point(AR.Right + scaled_depth, AR.Bottom - scaled_depth);
+            pts[2] := Point((AR.Left + AR.Right + scaled_depth) div 2, AR.Top - scaled_depth2);
+            ADrawer.BrushColor := GetDepthColor(c);
+            ADrawer.Polygon(pts, 0, 3);
+            pts[1] := Point(AR.Left, AR.Bottom);
+            ADrawer.Polygon(pts, 0, 3);
+            pts[0] := Point(AR.Right + scaled_depth, AR.Bottom - scaled_depth);
+            pts[1] := Point(AR.Right, AR.Bottom);
+            ADrawer.Polygon(pts, 0, 3);
+            ADrawer.BrushColor := c;
+            pts[0] := Point(AR.Left, AR.Bottom);
+            ADrawer.Polygon(pts, 0, 3);
+          end;
+        end;
+      bsCylindrical:
+        begin
+          if Depth = 0 then
+            ADrawer.Rectangle(AR)
+          else begin
+            ADrawer.Ellipse(AR.Left, AR.Bottom, AR.Right, AR.Bottom - scaled_depth);
+            ADrawer.FillRect(AR.Left, AR.Bottom - scaled_depth2, AR.Right, AR.Top - scaled_depth2);
+            ADrawer.Line(AR.Left, AR.Bottom - scaled_depth2, AR.Left, AR.Top - scaled_depth2);
+            ADrawer.Line(AR.Right, AR.Bottom - scaled_depth2, AR.Right, AR.Top - scaled_depth2);
+            ADrawer.BrushColor := GetDepthColor(ADrawer.BrushColor, true);
+            ADrawer.Ellipse(AR.Left, AR.Top, AR.Right, AR.Top - scaled_depth);
+          end;
+        end;
+      bsConical:
+        begin
+          SetLength(pts, 3);
+          if Depth = 0 then begin
+            pts[0] := Point(AR.Left, AR.Bottom);
+            pts[1] := Point(AR.Right, AR.Bottom);
+            pts[2] := Point((AR.Left + AR.Right) div 2, AR.Top);
+            ADrawer.Polygon(pts, 0, 3);
+          end else begin
+            ADrawer.Ellipse(AR.Left, AR.Bottom, AR.Right, AR.Bottom - scaled_depth);
+            // https://www.emathzone.com/tutorials/geometry/equation-of-tangent-and-normal-to-ellipse.html
+            // tangent to ellipse (x/a)² + (y/b)² = 1 at ellipse point (x1, y1):
+            //    (x1 x) / a² + (y1 x) / b² = 1
+            h := AR.Bottom - AR.Top;      // height of cone
+            if h > scaled_depth2 then begin
+              a := (AR.Right - AR.Left) * 0.5;
+              b := scaled_depth2;
+              cx := (AR.Left + AR.Right) * 0.5;    // center of cone ground area
+              cy := AR.Bottom - scaled_depth2;
+              factor := sqrt(1 - sqr(b/h));
+              pts[0] := Point(round(cx - a*factor), round(cy - sqr(b) / h));
+              pts[1] := Point((AR.Left + AR.Right) div 2, AR.Top - scaled_depth2);
+              pts[2] := Point(round(cx + a*factor), round(cy - sqr(b) / h));
+              ADrawer.SetPenParams(psClear, clTAColor);
+              ADrawer.Polygon(pts, 0, 3);
+              ADrawer.Pen := BarPen;
+              if Styles <> nil then
+                Styles.Apply(ADrawer, stackIndex);
+              ADrawer.PolyLine(pts, 0, 3);
+            end;
+          end;
+        end;
+      bsHexPrism:
+        begin
+          a := (AR.Right - AR.Left) * 0.5;
+          cx := (AR.Left + AR.Right) * 0.5;
+          cy := scaled_depth2;
+          SetLength(pts, 4);
+          factor := sin(pi * 30 / 180);
+          if Depth = 0 then begin
+            pts[0] := Point(AR.Left, AR.Bottom);
+            pts[1] := Point(round(cx - a*factor), AR.Bottom);
+            pts[2] := Point(pts[1].X, AR.Top);
+            pts[3] := Point(AR.Left, AR.Top);
+            ADrawer.Polygon(pts, 0, 4);
+            pts[0] := pts[1];
+            pts[3] := pts[2];
+            pts[1] := Point(round(cx + a*factor), AR.Bottom);
+            pts[2] := Point(pts[1].X, AR.Top);
+            ADrawer.Polygon(pts, 0, 4);
+            pts[0] := pts[1];
+            pts[3] := pts[2];
+            pts[1] := Point(AR.Right, AR.Bottom);
+            pts[2] := Point(AR.Right, AR.Top);
+            ADrawer.Polygon(pts, 0, 4);
+          end else begin
+            c := ADrawer.BrushColor;
+            pts[0] := Point(AR.Left, AR.Bottom - scaled_depth2);
+            pts[1] := Point(round(cx - a*factor), AR.Bottom);
+            pts[2] := Point(pts[1].X, AR.Top);
+            pts[3] := Point(AR.Left, AR.Top - scaled_depth2);
+            ADrawer.BrushColor := GetDepthColor(c);
+            ADrawer.Polygon(pts, 0, 4);
+            pts[0] := pts[1];
+            pts[3] := pts[2];
+            pts[1] := Point(round(cx + a*factor), AR.Bottom);
+            pts[2] := Point(pts[1].X, AR.Top);
+            ADrawer.BrushColor := c;
+            ADrawer.Polygon(pts, 0, 4);
+            pts[0] := pts[1];
+            pts[3] := pts[2];
+            pts[1] := Point(AR.Right, AR.Bottom - scaled_depth2);
+            pts[2] := Point(AR.Right, AR.Top - scaled_depth2);
+            ADrawer.BrushColor := GetDepthColor(c);
+            ADrawer.Polygon(pts, 0, 4);
+            SetLength(pts, 6);
+            pts[0] := Point(AR.Left, AR.Top - scaled_depth2);
+            pts[1] := Point(round(cx - a*factor), AR.Top);
+            pts[2] := Point(round(cx + a*factor), AR.Top);
+            pts[3] := Point(AR.Right, AR.Top - scaled_depth2);
+            pts[4] := Point(round(cx + a*factor), AR.Top - scaled_depth);
+            pts[5] := Point(round(cx - a*factor), AR.Top - scaled_depth);
+            ADrawer.BrushColor := GetDepthColor(c, true);
+            ADrawer.Polygon(pts, 0, 6);
+          end;
+        end;
+    end;
  end;

 var
@ -1226,6 +1366,7 @@ begin
  ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);

  scaled_depth := ADrawer.Scale(Depth);
+  scaled_depth2 := scaled_depth div 2;
  if UseZeroLevel then
    zero := ZeroLevel
  else
@ -1436,6 +1577,13 @@ begin
  FBarPen.Assign(Value);
 end;

+procedure TBarSeries.SetBarShape(AValue: TBarshape);
+begin
+  if FBarshape = AValue then exit;
+  FBarShape := AValue;
+  UpdateParentChart;
+end;
+
 procedure TBarSeries.SetBarWidthPercent(Value: Integer);
 begin
  if (Value < 1) or (Value > 100) then