TAChart: Add new property DepthBrightnessDelta to some series for improved rendering in pseudo-3D mode. Update related demos.

git-svn-id: trunk@60659 -
This commit is contained in:
wp 2019-03-12 17:35:19 +00:00
parent 7c75981ce8
commit 9e111d1a22
10 changed files with 192 additions and 46 deletions

View File

@ -1,31 +1,35 @@
object Form1: TForm1
Left = 318
Left = 319
Height = 347
Top = 150
Top = 177
Width = 560
Caption = 'Form1'
ClientHeight = 347
ClientWidth = 560
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '0.9.31'
LCLVersion = '2.1.0.0'
object Chart1: TChart
Left = 0
Height = 297
Height = 306
Top = 0
Width = 560
AxisList = <
item
Grid.Color = clGray
AxisPen.Visible = True
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Orientation = 900
Title.LabelBrush.Style = bsClear
end
item
Grid.Color = clGray
Alignment = calBottom
AxisPen.Visible = True
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelBrush.Style = bsClear
end>
BackColor = clSkyBlue
Depth = 50
@ -39,12 +43,12 @@ object Form1: TForm1
)
Align = alClient
Color = clWhite
ParentColor = False
object Chart1BarSeries1: TBarSeries
ZPosition = 10
BarBrush.Color = clTeal
BarWidthPercent = 50
Depth = 10
DepthBrightnessDelta = -32
Source = RandomChartSource1
end
object Chart1BarSeries2: TBarSeries
@ -52,6 +56,7 @@ object Form1: TForm1
BarBrush.Color = clMaroon
BarWidthPercent = 50
Depth = 10
DepthBrightnessDelta = -32
Source = RandomChartSource2
end
object Chart1LineSeries1: TLineSeries
@ -63,45 +68,91 @@ object Form1: TForm1
end
object pnControls: TPanel
Left = 0
Height = 50
Top = 297
Height = 41
Top = 306
Width = 560
Align = alBottom
ClientHeight = 50
AutoSize = True
ClientHeight = 41
ClientWidth = 560
TabOrder = 1
object seDepth: TSpinEdit
AnchorSideLeft.Control = lblDepth
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = pnControls
Left = 52
Height = 21
Top = 7
Height = 23
Top = 9
Width = 74
BorderSpacing.Around = 8
OnChange = seDepthChange
TabOrder = 0
end
object lblDepth: TLabel
Left = 8
Height = 14
Top = 11
Width = 34
AnchorSideLeft.Control = pnControls
AnchorSideTop.Control = seDepth
AnchorSideTop.Side = asrCenter
Left = 9
Height = 15
Top = 13
Width = 35
BorderSpacing.Left = 8
Caption = 'Depth:'
ParentColor = False
end
object seAxisZ: TSpinEdit
Left = 196
Height = 21
Top = 7
AnchorSideLeft.Control = lblAxisZ
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seDepth
Left = 192
Height = 23
Top = 9
Width = 74
BorderSpacing.Left = 8
OnChange = seAxisZChange
TabOrder = 1
end
object lblAxisZ: TLabel
Left = 152
Height = 14
Top = 11
AnchorSideLeft.Control = seDepth
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seAxisZ
AnchorSideTop.Side = asrCenter
Left = 150
Height = 15
Top = 13
Width = 34
BorderSpacing.Left = 24
Caption = 'Axis Z:'
ParentColor = False
end
object lblDepthBrightnessDelta: TLabel
AnchorSideLeft.Control = seAxisZ
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seDepthBrighnessDelta
AnchorSideTop.Side = asrCenter
Left = 290
Height = 15
Top = 13
Width = 149
BorderSpacing.Left = 24
Caption = 'Depth brightness difference:'
ParentColor = False
end
object seDepthBrighnessDelta: TSpinEdit
AnchorSideLeft.Control = lblDepthBrightnessDelta
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seDepth
Left = 447
Height = 23
Top = 9
Width = 76
BorderSpacing.Left = 8
MaxValue = 255
MinValue = -255
OnChange = seDepthBrighnessDeltaChange
TabOrder = 2
Value = -32
end
end
object RandomChartSource1: TRandomChartSource
PointsNumber = 7

View File

@ -17,6 +17,7 @@ type
Chart1BarSeries1: TBarSeries;
Chart1BarSeries2: TBarSeries;
Chart1LineSeries1: TLineSeries;
lblDepthBrightnessDelta: TLabel;
lblDepth: TLabel;
lblAxisZ: TLabel;
pnControls: TPanel;
@ -24,9 +25,11 @@ type
RandomChartSource2: TRandomChartSource;
seDepth: TSpinEdit;
seAxisZ: TSpinEdit;
seDepthBrighnessDelta: TSpinEdit;
procedure FormShow(Sender: TObject);
procedure seAxisZChange(Sender: TObject);
procedure seDepthChange(Sender: TObject);
procedure seDepthBrighnessDeltaChange(Sender: TObject);
end;
var
@ -61,5 +64,12 @@ begin
s.Depth := Min(seDepth.Value, 10);
end;
procedure TForm1.seDepthBrighnessDeltaChange(Sender: TObject);
begin
Chart1BarSeries1.DepthBrightnessDelta := seDepthBrighnessDelta.Value;
Chart1BarSeries2.DepthBrightnessDelta := seDepthBrighnessDelta.Value;
Chart1LineSeries1.DepthBrightnessDelta := seDepthBrighnessDelta.Value;
end;
end.

View File

@ -11,6 +11,10 @@
<MainUnit Value="0"/>
<Title Value="TAChart 3D look demo"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
</General>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>

View File

@ -10,8 +10,10 @@ uses
Forms
{ you can add units after this }, main, TAChartLazarusPkg;
{$R *.res}
begin
Application.Title := 'TAChart 3D look demo';
Application.Title:='TAChart 3D look demo';
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;

View File

@ -24,13 +24,13 @@ object Form1: TForm1
ClientWidth = 678
object Panel1: TPanel
Left = 0
Height = 81
Top = 323
Height = 87
Top = 317
Width = 678
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 81
ClientHeight = 87
ClientWidth = 678
TabOrder = 0
object CbRotated: TCheckBox
@ -106,14 +106,15 @@ object Form1: TForm1
TabOrder = 4
end
object LblCount: TLabel
AnchorSideLeft.Control = BtnNewData
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbStacked
AnchorSideTop.Side = asrCenter
Left = 525
AnchorSideRight.Control = EdYCount
Left = 533
Height = 15
Top = 10
Width = 33
Anchors = [akTop, akRight]
BorderSpacing.Left = 16
Caption = 'Count'
FocusControl = EdCount
@ -260,10 +261,41 @@ object Form1: TForm1
OnChange = CbCenteredChange
TabOrder = 13
end
object EdDepthBrightnessDelta: TSpinEdit
AnchorSideLeft.Control = LblYCount
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = EdYCount
AnchorSideTop.Side = asrBottom
Left = 574
Height = 23
Top = 60
Width = 50
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Enabled = False
MaxValue = 255
MinValue = -255
OnChange = EdDepthBrightnessDeltaChange
TabOrder = 14
end
object LblDepthBrightnessDelta: TLabel
AnchorSideTop.Control = EdDepthBrightnessDelta
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = EdYCount
Left = 447
Height = 15
Top = 64
Width = 119
Anchors = [akTop, akRight]
Caption = 'Depth brightness delta'
Enabled = False
ParentColor = False
end
end
object Chart1: TChart
Left = 0
Height = 323
Height = 317
Top = 0
Width = 678
AxisList = <
@ -290,10 +322,10 @@ object Form1: TForm1
Color = clWindow
object Chart1AreaSeries1: TAreaSeries
Legend.Multiplicity = lmStyle
Marks.YIndex = -1
AxisIndexX = 1
AxisIndexY = 0
AreaContourPen.Width = 3
Marks.YIndex = -1
Styles = ChartStyles1
UseZeroLevel = True
end

View File

@ -35,8 +35,10 @@ type
CbShowLegend: TCheckBox;
CbCentered: TCheckBox;
EdYCount: TSpinEdit;
EdDepthBrightnessDelta: TSpinEdit;
EdZeroLevel: TFloatSpinEdit;
Label1: TLabel;
LblDepthBrightnessDelta: TLabel;
LblCount: TLabel;
LblYCount: TLabel;
PageControl1: TPageControl;
@ -69,6 +71,7 @@ type
ASource: TUserDefinedChartSource; AIndex: Integer;
var AItem: TChartDataItem);
procedure CbShowDropLinesChange(Sender: TObject);
procedure EdDepthBrightnessDeltaChange(Sender: TObject);
procedure EdYCountChange(Sender: TObject);
procedure EdZeroLevelChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -177,6 +180,8 @@ begin
Chart1AreaSeries1.Depth := IfThen(Cb3D.Checked, DEPTH, 0);
Chart1.Margins.Right := 4 + Chart1AreaSeries1.Depth;
Chart1.Margins.Top := 4 + Chart1AreaSeries1.Depth;
EdDepthBrightnessDelta.Enabled := Cb3D.Checked;
lblDepthBrightnessDelta.Enabled := Cb3D.Checked;
end;
procedure TForm1.CbUseZeroLevelChange(Sender: TObject);
@ -223,6 +228,11 @@ begin
Chart1AreaSeries1.AreaLinesPen.Style := psClear;
end;
procedure TForm1.EdDepthBrightnessDeltaChange(Sender: TObject);
begin
Chart1AreaSeries1.DepthBrightnessDelta := EdDepthBrightnessDelta.Value;
end;
procedure TForm1.EdYCountChange(Sender: TObject);
begin
PopulateSeries(EdCount.Value, EdYCount.Value);

View File

@ -50,11 +50,13 @@ type
strict private
FAxisIndexX: TChartAxisIndex;
FAxisIndexY: TChartAxisIndex;
FDepthBrightnessDelta: Integer;
FLegend: TChartSeriesLegend;
FToolTargets: TNearestPointTargets;
FTitle: String;
procedure SetAxisIndexX(AValue: TChartAxisIndex);
procedure SetAxisIndexY(AValue: TChartAxisIndex);
procedure SetDepthBrightnessDelta(AValue: Integer);
procedure SetLegend(AValue: TChartSeriesLegend);
protected
@ -85,6 +87,8 @@ type
function LegendTextStyle(AStyle: TChartStyle): String;
procedure SetIndex(AValue: Integer); override;
function TitleIsStored: Boolean; virtual;
property DepthBrightnessDelta: Integer
read FDepthBrightnessDelta write SetDepthBrightnessDelta default 0;
property ToolTargets: TNearestPointTargets
read FToolTargets write FToolTargets default [nptPoint];
@ -95,6 +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 GetGraphBounds: TDoubleRect; override;
function GraphToAxis(APoint: TDoublePoint): TDoublePoint;
function GraphToAxisX(AX: Double): Double; override;
@ -385,6 +390,7 @@ begin
with TCustomChartSeries(ASource) do begin
Self.FAxisIndexX := FAxisIndexX;
Self.FAxisIndexY := FAxisIndexY;
Self.FDepthBrightnessDelta := FDepthBrightnessDelta;
Self.Legend := FLegend;
Self.FTitle := FTitle;
Self.FToolTargets := FToolTargets;
@ -467,6 +473,18 @@ begin
Result := FChart.LeftAxis;
end;
function TCustomChartSeries.GetDepthColor(AColor: Integer): Integer;
type
TBytes = packed array [1..4] of Byte;
var
c: TBytes absolute AColor;
r: TBytes absolute Result;
i: Integer;
begin
for i := 1 to 4 do
r[i] := EnsureRange(c[i] + FDepthBrightnessDelta, 0, 255);
end;
function TCustomChartSeries.GetGraphBounds: TDoubleRect;
begin
Result := EmptyExtent;
@ -629,6 +647,13 @@ begin
UpdateParentChart;
end;
procedure TCustomChartSeries.SetDepthBrightnessDelta(AValue: Integer);
begin
if FDepthBrightnessDelta = AValue then exit;
FDepthBrightnessDelta := AValue;
UpdateParentChart;
end;
procedure TCustomChartSeries.SetIndex(AValue: Integer);
begin
with FChart.Series.List do

View File

@ -1950,20 +1950,6 @@ begin
// empty
end;
function TBasicChartSeries.RequestValidChartScaling: Boolean;
begin
Result := false;
if not Assigned(FChart) then exit;
// We request a valid scaling from FChart. Scaling is not initialized during
// the first phase of scaling calculation, so we request more phases. If we
// are already beyond the scaling calculation loop, our request will be just
// ignored.
FChart.RequestMultiPassScaling;
Result := FChart.ScalingValid;
end;
destructor TBasicChartSeries.Destroy;
begin
if FChart <> nil then
@ -2000,6 +1986,20 @@ begin
MovePoint(AIndex, ANewPos);
end;
function TBasicChartSeries.RequestValidChartScaling: Boolean;
begin
Result := false;
if not Assigned(FChart) then exit;
// We request a valid scaling from FChart. Scaling is not initialized during
// the first phase of scaling calculation, so we request more phases. If we
// are already beyond the scaling calculation loop, our request will be just
// ignored.
FChart.RequestMultiPassScaling;
Result := FChart.ScalingValid;
end;
procedure TBasicChartSeries.UpdateBiDiMode;
begin
// normally nothing to do. Override, e.g., to flip arrows

View File

@ -107,6 +107,7 @@ type
read FMarkPositions write SetMarkPositions default pmpAround;
property RotateLabels: Boolean
read FRotateLabels write SetRotateLabels default false;
end;
TSinCos = record
@ -328,7 +329,7 @@ var
p[High(p) - i - 1] := p[i] + Point(scaled_depth, -scaled_depth);
end;
p[High(p)] := p[0];
clr := SliceColor(ASlice.FOrigIndex);
clr := GetDepthColor(SliceColor(ASlice.FOrigIndex));
ADrawer.SetBrushParams(bsSolid, clr);
ADrawer.SetPenParams(psSolid, clr);
ADrawer.Polygon(p, 0, Length(p));
@ -338,14 +339,16 @@ var
procedure DrawStartEdge3D(ASlice: TPieSlice);
begin
ADrawer.SetBrushParams(bsSolid, SliceColor(ASlice.FOrigIndex));
ADrawer.SetBrushParams(
bsSolid, GetDepthColor(SliceColor(ASlice.FOrigIndex)));
ADrawer.DrawLineDepth(
ASlice.FBase, ASlice.FBase + RotatePointX(FRadius, -ASlice.FPrevAngle), scaled_depth);
end;
procedure DrawEndEdge3D(ASlice: TPieSlice);
begin
ADrawer.SetBrushParams(bsSolid, SliceColor(ASlice.FOrigIndex));
ADrawer.SetBrushParams(
bsSolid, GetDepthColor(SliceColor(ASlice.FOrigIndex)));
ADrawer.DrawLineDepth(
ASlice.FBase, ASlice.FBase + RotatePointX(FRadius, -ASlice.FNextAngle), scaled_depth);
end;

View File

@ -96,6 +96,7 @@ type
property BarWidthStyle: TBarWidthStyle
read FBarWidthStyle write SetBarWidthStyle default bwPercent;
property Depth;
property DepthBrightnessDelta;
property MarkPositionCentered;
property MarkPositions;
property Marks;
@ -124,6 +125,7 @@ type
published
property EdgePen;
property Depth;
property DepthBrightnessDelta;
property Exploded;
property FixedRadius;
property MarkDistancePercent;
@ -178,6 +180,7 @@ type
property ConnectType: TConnectType
read FConnectType write SetConnectType default ctLine;
property Depth;
property DepthBrightnessDelta;
property MarkPositionCentered;
property MarkPositions;
property Marks;
@ -237,6 +240,7 @@ type
property ColorEach: TColorEachMode
read FColorEach write SetColorEach default cePoint;
property Depth;
property DepthBrightnessDelta;
property LinePen: TPen read FLinePen write SetLinePen;
property LineType: TLineType
read FLineType write SetLineType default ltFromPrevious;
@ -587,7 +591,7 @@ var
ADrawer.Polyline(points, breaks[i], breaks[i + 1] - breaks[i])
else begin
if Styles = nil then begin
ADrawer.SetBrushParams(bsSolid, LinePen.Color);
ADrawer.SetBrushParams(bsSolid, GetDepthColor(LinePen.Color));
ADrawer.SetPenParams(LinePen.Style, clBlack);
end;
scaled_depth := ADrawer.Scale(Depth);
@ -1152,6 +1156,7 @@ var
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);
@ -1733,6 +1738,7 @@ var
p: TDoublePoint;
i, j, j0: Integer;
zeroPt: TPoint;
c: TColor;
begin
// Get baseline of area series: this is the curve of the 1st y value in case
// of banded, or the zero level in case for normal area series.
@ -1776,12 +1782,15 @@ var
// Note: Rendering is often incorrect, e.g. when values cross zero level
// or when values are not stacked!
if (Depth > 0) then begin
c := ADrawer.BrushColor;
ADrawer.BrushColor := GetDepthColor(c);
// Top sides
if (Source.YCount = 1) or (not FStacked) or (j = Source.YCount-2) then
for i := 0 to numDataPts-2 do
ADrawer.DrawLineDepth(pts[i], pts[i+1], scaled_depth);
// Sides at the right
ADrawer.DrawLineDepth(pts[numdataPts-1], pts[numDataPts], scaled_depth);
ADrawer.BrushColor := c;
end;
// Fill polygon of current level