TAChart: New TLineSeries property ColorEach for individual coloring of line segments.

git-svn-id: trunk@57277 -
This commit is contained in:
wp 2018-02-10 20:41:31 +00:00
parent a48b727337
commit 762e695242
4 changed files with 117 additions and 8 deletions

View File

@ -266,7 +266,7 @@ type
implementation
uses
LResources, Math, PropEdits, TAChartStrConsts, TAGeometry, TAMath;
LResources, Math, PropEdits, TAChartStrConsts, TAMath;
var
VIdentityTransform: TChartAxisTransformations;

View File

@ -277,7 +277,8 @@ type
procedure AfterDrawPointer(
ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint); virtual;
procedure DrawLabels(ADrawer: IChartDrawer);
procedure DrawPointers(ADrawer: IChartDrawer; AStyleIndex: Integer = 0);
procedure DrawPointers(ADrawer: IChartDrawer; AStyleIndex: Integer = 0;
UseDataColors: Boolean = false);
procedure FindExtentInterval(
const AExtent: TDoubleRect; AFilterByExtent: Boolean);
function GetLabelDataPoint(AIndex: Integer): TDoublePoint; virtual;
@ -1198,13 +1199,14 @@ end;
If ChartStyles are attached to the series then the pointer brush is determined
by the style with the specified index. }
procedure TBasicPointSeries.DrawPointers(ADrawer: IChartDrawer;
AStyleIndex: Integer = 0);
AStyleIndex: Integer = 0; UseDataColors: Boolean = false);
var
i: Integer;
p: TDoublePoint;
ai: TPoint;
ps, saved_ps: TSeriesPointerStyle;
brushAlreadySet: boolean;
c: TColor;
begin
Assert(Pointer <> nil, 'Series pointer');
if (not Pointer.Visible) or (Length(FGraphPoints) = 0) then exit;
@ -1227,7 +1229,8 @@ begin
Styles.Styles[AStyleIndex].UseBrush;
if brushAlreadySet then
Styles.Apply(ADrawer, AStyleIndex);
Pointer.Draw(ADrawer, ai, Source[i]^.Color, brushAlreadySet);
if UseDataColors then c := Source[i]^.Color else c := clTAColor;
Pointer.Draw(ADrawer, ai, c, brushAlreadySet);
AfterDrawPointer(ADrawer, i, ai);
if Assigned(FOnGetPointerStyle) then begin
Pointer.Style := saved_ps;

View File

@ -185,6 +185,9 @@ type
TLineType = (ltNone, ltFromPrevious, ltFromOrigin, ltStepXY, ltStepYX);
TColorEachMode = (ceNone, cePoint, ceLineBefore, ceLineAfter,
cePointAndLineBefore, cePointAndLineAfter);
{ TLineSeries }
TLineSeries = class(TBasicPointSeries)
@ -193,9 +196,11 @@ type
FLineType: TLineType;
FOnDrawPointer: TSeriesPointerDrawEvent;
FShowPoints: Boolean;
FColorEach: TColorEachMode;
procedure DrawSingleLineInStack(ADrawer: IChartDrawer; AIndex: Integer);
function GetShowLines: Boolean;
procedure SetColorEach(AValue: TColorEachMode);
procedure SetLinePen(AValue: TPen);
procedure SetLineType(AValue: TLineType);
procedure SetSeriesColor(AValue: TColor);
@ -214,6 +219,8 @@ type
published
property AxisIndexX;
property AxisIndexY;
property ColorEach: TColorEachMode
read FColorEach write SetColorEach default cePoint;
property Depth;
property LinePen: TPen read FLinePen write SetLinePen;
property LineType: TLineType
@ -374,6 +381,7 @@ begin
Self.FLineType := FLineType;
Self.FOnDrawPointer := FOnDrawPointer;
Self.FShowPoints := FShowPoints;
Self.FColorEach := FColorEach;
end;
inherited Assign(ASource);
end;
@ -382,6 +390,7 @@ constructor TLineSeries.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FColorEach := cePoint;
FLinePen := TPen.Create;
FLinePen.OnChange := @StyleChanged;
FPointer := TSeriesPointer.Create(FChart);
@ -494,7 +503,7 @@ var
CacheLine(m, AP2);
end;
procedure DrawLines;
procedure DrawDefaultLines;
var
i, j: Integer;
p, pPrev: TDoublePoint;
@ -556,11 +565,102 @@ var
end;
end;
function GetPtColor(AIndex: Integer): TColor;
begin
Result := Source[AIndex]^.Color;
if Result = clTAColor then Result := SeriesColor;
end;
procedure DrawColoredLines;
var
i, n: Integer;
gp: TDoublepoint;
col, col1, col2: TColor;
imgPt1, imgPt2: TPoint;
pt, origin: TPoint;
hasBreak: Boolean;
begin
if LineType = ltNone then exit;
n := Length(FGraphPoints);
// Find first point
i := 0;
while (i < n) do begin
gp := FGraphPoints[i];
if not IsNaN(gp) then break;
inc(i);
end;
if i = n then
exit;
ADrawer.Pen := LinePen;
imgPt1 := ParentChart.GraphToImage(gp);
col1 := GetPtColor(i);
// First line for line type ltFromOrigin
if LineType = ltFromOrigin then begin
origin := ParentChart.GraphToImage(AxisToGraph(ZeroDoublePoint));
ADrawer.SetPenParams(FLinePen.Style, col1);
ADrawer.Line(origin, imgPt1);
end;
// iterate through all other points
hasBreak := false;
while (i < n) do begin
gp := FGraphPoints[i];
if IsNaN(gp) then begin
hasBreak := true;
end else begin
if hasBreak then begin
imgPt1 := ParentChart.GraphToImage(gp);
hasBreak := false;
end;
imgPt2 := ParentChart.GraphToImage(gp);
col2 := GetPtColor(i);
if imgPt1 <> imgPt2 then begin
case FColorEach of
ceLineBefore, cePointAndLineBefore: col := col2;
ceLineAfter, cePointAndLineAfter: col := col1;
else raise Exception.Create('TLineSeries: ColorEach error');
end;
ADrawer.SetPenParams(FLinePen.Style, col);
case LineType of
ltFromPrevious:
ADrawer.Line(imgPt1, imgPt2);
ltStepXY:
begin
pt := Point(imgPt2.x, imgPt1.Y);
ADrawer.Line(imgPt1, pt);
ADrawer.Line(pt, imgPt2);
end;
ltStepYX:
begin
pt := Point(imgPt1.x, imgPt2.Y);
ADrawer.Line(imgPt1, pt);
ADrawer.Line(pt, imgPt2);
end;
ltFromOrigin:
ADrawer.Line(origin, imgPt2);
end;
end;
imgPt1 := imgPt2;
col1 := col2;
end;
inc(i);
end;
end;
begin
DrawLines;
case FColorEach of
ceNone, cePoint:
DrawDefaultLines;
else
DrawColoredLines;
end;
DrawLabels(ADrawer);
if ShowPoints then
DrawPointers(ADrawer, AIndex);
DrawPointers(ADrawer, AIndex, FColorEach in [cePoint, cePointAndLineBefore, cePointAndLineAfter]);
end;
procedure TLineSeries.GetLegendItems(AItems: TChartLegendItems);
@ -613,6 +713,13 @@ begin
Result := FLineType <> ltNone;
end;
procedure TLineSeries.SetColorEach(AValue: TColorEachMode);
begin
if FColorEach = AValue then exit;
FColorEach := AValue;
UpdateParentChart;
end;
procedure TLineSeries.SetLinePen(AValue: TPen);
begin
FLinePen.Assign(AValue);

View File

@ -334,7 +334,6 @@ var
var
i: Integer;
s: String;
begin
parts := Split(AString);
try