diff --git a/.gitattributes b/.gitattributes index bb39c04c72..7238ac6766 100644 --- 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 diff --git a/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi b/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi new file mode 100644 index 0000000000..571b34d49a --- /dev/null +++ b/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpi @@ -0,0 +1,81 @@ + + + + + + + + + <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> diff --git a/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr b/components/tachart/demo/barseriesshapes/BarShapes_Demo.lpr new file mode 100644 index 0000000000..ea4d1a8065 --- /dev/null +++ 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. + diff --git a/components/tachart/demo/barseriesshapes/main.lfm b/components/tachart/demo/barseriesshapes/main.lfm new file mode 100644 index 0000000000..8cf4e216ec --- /dev/null +++ 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 diff --git a/components/tachart/demo/barseriesshapes/main.pas b/components/tachart/demo/barseriesshapes/main.pas new file mode 100644 index 0000000000..91365d9346 --- /dev/null +++ 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. + diff --git a/components/tachart/fpdoc/tagraph.xml b/components/tachart/fpdoc/tagraph.xml index 6a04d32017..c75b52f3af 100644 --- 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> diff --git a/components/tachart/tacustomseries.pas b/components/tachart/tacustomseries.pas index b4b17155be..1432e7fd81 100644 --- 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; diff --git a/components/tachart/taseries.pas b/components/tachart/taseries.pas index 45ac4a9cca..2c8a4a7552 100644 --- 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