mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 14:01:49 +02:00
TAChart: Add property TBarShape to TBarSeries to allow painting of bars as cylinders, pyramids, prisms etc. Add related demo.
git-svn-id: trunk@60762 -
This commit is contained in:
parent
eab7d57403
commit
a4166ee45d
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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/axistransfdemo.lpr svneol=native#text/pascal
|
||||||
components/tachart/demo/axistransf/main.lfm svneol=native#text/plain
|
components/tachart/demo/axistransf/main.lfm svneol=native#text/plain
|
||||||
components/tachart/demo/axistransf/main.pas svneol=native#text/pascal
|
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.lpi svneol=native#text/plain
|
||||||
components/tachart/demo/barseriestools/barseriestools.lpr svneol=native#text/plain
|
components/tachart/demo/barseriestools/barseriestools.lpr svneol=native#text/plain
|
||||||
components/tachart/demo/barseriestools/main.lfm svneol=native#text/plain
|
components/tachart/demo/barseriestools/main.lfm svneol=native#text/plain
|
||||||
|
81
components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi
Normal file
81
components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi
Normal file
@ -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>
|
22
components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr
Normal file
22
components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr
Normal file
@ -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.
|
||||||
|
|
175
components/tachart/demo/barseriesshapes/main.lfm
Normal file
175
components/tachart/demo/barseriesshapes/main.lfm
Normal file
@ -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
|
69
components/tachart/demo/barseriesshapes/main.pas
Normal file
69
components/tachart/demo/barseriesshapes/main.pas
Normal file
@ -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.
|
||||||
|
|
@ -101,14 +101,12 @@ use
|
|||||||
</element>
|
</element>
|
||||||
<element name="TChart.Margins">
|
<element name="TChart.Margins">
|
||||||
<short>Margins around the chart sides in default extent, in pixels.</short>
|
<short>Margins around the chart sides in default extent, in pixels.</short>
|
||||||
<seealso>
|
<seealso><link id="TChart.BorderSpacing">BorderSpacing</link><link id="TChart.ExpandPercentage">ExpandPercentage</link><link id="TChart.Extent">Extent</link>
|
||||||
<link id="TChart.BorderSpacing">BorderSpacing</link>
|
|
||||||
<link id="TChart.ExpandPercentage">ExpandPercentage</link>
|
|
||||||
<link id="TChart.Extent">Extent</link>
|
|
||||||
</seealso>
|
</seealso>
|
||||||
<descr>Note that the margins set by this property have effect only on the default extent.
|
<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
|
Use <link id="TChart.BorderSpacing">BorderSpacing</link> property to set margins
|
||||||
independently of zoom level.</descr>
|
independently of zoom level.
|
||||||
|
</descr>
|
||||||
</element>
|
</element>
|
||||||
<element name="TChart.Extent">
|
<element name="TChart.Extent">
|
||||||
<short>Manual overrides for the chart extent borders.</short>
|
<short>Manual overrides for the chart extent borders.</short>
|
||||||
|
@ -99,7 +99,7 @@ type
|
|||||||
function GetAxisX: TChartAxis;
|
function GetAxisX: TChartAxis;
|
||||||
function GetAxisY: TChartAxis;
|
function GetAxisY: TChartAxis;
|
||||||
function GetAxisBounds(AAxis: TChartAxis; out AMin, AMax: Double): Boolean; override;
|
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 GetGraphBounds: TDoubleRect; override;
|
||||||
function GraphToAxis(APoint: TDoublePoint): TDoublePoint;
|
function GraphToAxis(APoint: TDoublePoint): TDoublePoint;
|
||||||
function GraphToAxisX(AX: Double): Double; override;
|
function GraphToAxisX(AX: Double): Double; override;
|
||||||
@ -363,7 +363,7 @@ type
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Math, PropEdits, StrUtils, LResources, Types,
|
Math, PropEdits, StrUtils, LResources, Types, GraphUtil,
|
||||||
TAChartStrConsts, TAGeometry, TAMath;
|
TAChartStrConsts, TAGeometry, TAMath;
|
||||||
|
|
||||||
function CreateLazIntfImage(
|
function CreateLazIntfImage(
|
||||||
@ -473,16 +473,16 @@ begin
|
|||||||
Result := FChart.LeftAxis;
|
Result := FChart.LeftAxis;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TCustomChartSeries.GetDepthColor(AColor: Integer): Integer;
|
function TCustomChartSeries.GetDepthColor(AColor: Integer;
|
||||||
type
|
Opposite: Boolean = false): Integer;
|
||||||
TBytes = packed array [1..4] of Byte;
|
|
||||||
var
|
var
|
||||||
c: TBytes absolute AColor;
|
h, l, s: Byte;
|
||||||
r: TBytes absolute Result;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
begin
|
||||||
for i := 1 to 4 do
|
ColorToHLS(AColor, h, l, s);
|
||||||
r[i] := EnsureRange(c[i] + FDepthBrightnessDelta, 0, 255);
|
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;
|
end;
|
||||||
|
|
||||||
function TCustomChartSeries.GetGraphBounds: TDoubleRect;
|
function TCustomChartSeries.GetGraphBounds: TDoubleRect;
|
||||||
|
@ -32,6 +32,8 @@ const
|
|||||||
type
|
type
|
||||||
EBarError = class(EChartError);
|
EBarError = class(EChartError);
|
||||||
|
|
||||||
|
TBarShape = (bsRectangular, bsCylindrical, bsHexPrism, bsPyramid, bsConical);
|
||||||
|
|
||||||
TBarWidthStyle = (bwPercent, bwPercentMin);
|
TBarWidthStyle = (bwPercent, bwPercentMin);
|
||||||
|
|
||||||
TBarSeries = class;
|
TBarSeries = class;
|
||||||
@ -52,6 +54,7 @@ type
|
|||||||
FBarBrush: TBrush;
|
FBarBrush: TBrush;
|
||||||
FBarOffsetPercent: Integer;
|
FBarOffsetPercent: Integer;
|
||||||
FBarPen: TPen;
|
FBarPen: TPen;
|
||||||
|
FBarShape: TBarShape;
|
||||||
FBarWidthPercent: Integer;
|
FBarWidthPercent: Integer;
|
||||||
FBarWidthStyle: TBarWidthStyle;
|
FBarWidthStyle: TBarWidthStyle;
|
||||||
FOnBeforeDrawBar: TBeforeDrawBarEvent;
|
FOnBeforeDrawBar: TBeforeDrawBarEvent;
|
||||||
@ -63,6 +66,7 @@ type
|
|||||||
procedure SetBarBrush(Value: TBrush);
|
procedure SetBarBrush(Value: TBrush);
|
||||||
procedure SetBarOffsetPercent(AValue: Integer);
|
procedure SetBarOffsetPercent(AValue: Integer);
|
||||||
procedure SetBarPen(Value: TPen);
|
procedure SetBarPen(Value: TPen);
|
||||||
|
procedure SetBarShape(AValue: TBarShape);
|
||||||
procedure SetBarWidthPercent(Value: Integer);
|
procedure SetBarWidthPercent(Value: Integer);
|
||||||
procedure SetBarWidthStyle(AValue: TBarWidthStyle);
|
procedure SetBarWidthStyle(AValue: TBarWidthStyle);
|
||||||
procedure SetOnBeforeDrawBar(AValue: TBeforeDrawBarEvent);
|
procedure SetOnBeforeDrawBar(AValue: TBeforeDrawBarEvent);
|
||||||
@ -97,6 +101,7 @@ type
|
|||||||
property BarOffsetPercent: Integer
|
property BarOffsetPercent: Integer
|
||||||
read FBarOffsetPercent write SetBarOffsetPercent default 0;
|
read FBarOffsetPercent write SetBarOffsetPercent default 0;
|
||||||
property BarPen: TPen read FBarPen write SetBarPen;
|
property BarPen: TPen read FBarPen write SetBarPen;
|
||||||
|
property BarShape: TBarShape read FBarshape write SetBarShape default bsRectangular;
|
||||||
property BarWidthPercent: Integer
|
property BarWidthPercent: Integer
|
||||||
read FBarWidthPercent write SetBarWidthPercent default DEF_BAR_WIDTH_PERCENT;
|
read FBarWidthPercent write SetBarWidthPercent default DEF_BAR_WIDTH_PERCENT;
|
||||||
property BarWidthStyle: TBarWidthStyle
|
property BarWidthStyle: TBarWidthStyle
|
||||||
@ -1141,6 +1146,7 @@ procedure TBarSeries.Draw(ADrawer: IChartDrawer);
|
|||||||
var
|
var
|
||||||
pointIndex, stackIndex: Integer;
|
pointIndex, stackIndex: Integer;
|
||||||
scaled_depth: Integer;
|
scaled_depth: Integer;
|
||||||
|
scaled_depth2: Integer;
|
||||||
|
|
||||||
procedure DrawBar(const AR: TRect);
|
procedure DrawBar(const AR: TRect);
|
||||||
var
|
var
|
||||||
@ -1148,6 +1154,9 @@ var
|
|||||||
defaultDrawing: Boolean = true;
|
defaultDrawing: Boolean = true;
|
||||||
c: TColor;
|
c: TColor;
|
||||||
ic: IChartTCanvasDrawer;
|
ic: IChartTCanvasDrawer;
|
||||||
|
pts: TPointArray;
|
||||||
|
a, b, cx, cy, factor: Double;
|
||||||
|
h: Integer;
|
||||||
begin
|
begin
|
||||||
ADrawer.Pen := BarPen;
|
ADrawer.Pen := BarPen;
|
||||||
ADrawer.Brush := BarBrush;
|
ADrawer.Brush := BarBrush;
|
||||||
@ -1171,14 +1180,145 @@ var
|
|||||||
OnBeforeDrawBar(Self, ic.Canvas, AR, pointIndex, stackIndex, defaultDrawing);
|
OnBeforeDrawBar(Self, ic.Canvas, AR, pointIndex, stackIndex, defaultDrawing);
|
||||||
if not defaultDrawing then exit;
|
if not defaultDrawing then exit;
|
||||||
|
|
||||||
ADrawer.Rectangle(AR);
|
case FBarShape of
|
||||||
|
bsRectangular:
|
||||||
if Depth = 0 then exit;
|
begin
|
||||||
|
ADrawer.Rectangle(AR);
|
||||||
ADrawer.BrushColor := GetDepthColor(ADrawer.BrushColor);
|
if Depth > 0 then begin
|
||||||
ADrawer.DrawLineDepth(AR.Left, AR.Top, AR.Right - 1, AR.Top, scaled_depth);
|
c := ADrawer.BrushColor;
|
||||||
ADrawer.DrawLineDepth(
|
ADrawer.BrushColor := GetDepthColor(c, true);
|
||||||
AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, scaled_depth);
|
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;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -1226,6 +1366,7 @@ begin
|
|||||||
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
|
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
|
||||||
|
|
||||||
scaled_depth := ADrawer.Scale(Depth);
|
scaled_depth := ADrawer.Scale(Depth);
|
||||||
|
scaled_depth2 := scaled_depth div 2;
|
||||||
if UseZeroLevel then
|
if UseZeroLevel then
|
||||||
zero := ZeroLevel
|
zero := ZeroLevel
|
||||||
else
|
else
|
||||||
@ -1436,6 +1577,13 @@ begin
|
|||||||
FBarPen.Assign(Value);
|
FBarPen.Assign(Value);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TBarSeries.SetBarShape(AValue: TBarshape);
|
||||||
|
begin
|
||||||
|
if FBarshape = AValue then exit;
|
||||||
|
FBarShape := AValue;
|
||||||
|
UpdateParentChart;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TBarSeries.SetBarWidthPercent(Value: Integer);
|
procedure TBarSeries.SetBarWidthPercent(Value: Integer);
|
||||||
begin
|
begin
|
||||||
if (Value < 1) or (Value > 100) then
|
if (Value < 1) or (Value > 100) then
|
||||||
|
Loading…
Reference in New Issue
Block a user