TAChart: Fix several bugs related to incorrect scaling for printing

git-svn-id: trunk@47203 -
This commit is contained in:
wp 2014-12-15 13:59:56 +00:00
parent 8a48485cac
commit 01cb0be6e0
5 changed files with 124 additions and 112 deletions

View File

@ -935,8 +935,21 @@ begin
end;
procedure TBSplineSeries.GetLegendItems(AItems: TChartLegendItems);
var
cp: TChartPen;
p: TSeriesPointer;
begin
AItems.Add(TLegendItemLine.Create(Pen, LegendTextSingle));
if FPen.Visible and (FPen.Style <> psClear) then
cp := FPen
else
cp := nil;
if FPointer.Visible then
p := FPointer
else
p := nil;
AItems.Add(TLegendItemLinePointer.Create(cp, p, LegendTextSingle));
end;
procedure TBSplineSeries.InternalPrepareGraphPoints;
@ -1180,8 +1193,21 @@ begin
end;
procedure TCubicSplineSeries.GetLegendItems(AItems: TChartLegendItems);
var
cp: TChartPen;
p: TSeriesPointer;
begin
AItems.Add(TLegendItemLine.Create(Pen, LegendTextSingle));
if FPen.Visible and (FPen.Style <> psClear) then
cp := FPen
else
cp := nil;
if FPointer.Visible then
p := FPointer
else
p := nil;
AItems.Add(TLegendItemLinePointer.Create(cp, p, LegendTextSingle));
end;
function TCubicSplineSeries.GetNearestPoint(
@ -1653,6 +1679,8 @@ var
optimize: Boolean;
x, y: Integer;
cellColor: TChartColor;
scaled_stepX: Integer;
scaled_stepY: Integer;
begin
if not (csDesigning in ComponentState) and IsEmpty then exit;
@ -1667,7 +1695,6 @@ begin
r.BottomRight := ParentChart.GraphToImage(ext.b);
NormalizeRect(r);
offset := ParentChart.GraphToImage(ZeroDoublePoint);
pt.Y := (r.Top div StepY - 1) * StepY + offset.Y mod StepY;
case UseImage of
cmuiAuto: optimize := (StepX <= 2) and (StepY <= 2);
@ -1681,16 +1708,20 @@ begin
ADrawer.SetPenParams(psClear, clTAColor);
end;
if StepX > 1 then scaled_stepX := Max(1, ADrawer.Scale(StepX));
if StepY > 1 then scaled_stepY := Max(1, ADrawer.Scale(StepY));
try
pt.Y := (r.Top div scaled_stepY - 1) * scaled_stepY + offset.Y mod scaled_stepY;
while pt.Y <= r.Bottom do begin
next.Y := pt.Y + StepY;
next.Y := pt.Y + scaled_stepY;
if next.Y <= r.Top then begin
pt.Y := next.Y;
continue;
end;
pt.X := (r.Left div StepX - 1) * StepX + offset.X mod StepX;
pt.X := (r.Left div scaled_stepX - 1) * scaled_stepX + offset.X mod scaled_stepX;
while pt.X <= r.Right do begin
next.X := pt.X + StepX;
next.X := pt.X + scaled_stepX;
if next.X <= r.Left then begin
pt.X := next.X;
continue;

View File

@ -713,6 +713,8 @@ procedure TChart.DisplaySeries(ADrawer: IChartDrawer);
procedure OffsetWithDepth(AZPos, ADepth: Integer);
begin
AZPos := ADrawer.Scale(AZPos);
ADepth := ADrawer.Scale(ADepth);
OffsetDrawArea(-AZPos, AZPos);
FClipRect.Right += ADepth;
FClipRect.Top -= ADepth;
@ -882,6 +884,7 @@ procedure TChart.DrawBackWall(ADrawer: IChartDrawer);
var
defaultDrawing: Boolean = true;
ic: IChartTCanvasDrawer;
scaled_depth: Integer;
begin
if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBackWall) then
OnBeforeDrawBackWall(Self, ic.Canvas, FClipRect, defaultDrawing);
@ -900,9 +903,10 @@ begin
// Z axis
if (Depth > 0) and FFrame.Visible then begin
scaled_depth := ADrawer.Scale(Depth);
ADrawer.Pen := FFrame;
with FClipRect do
ADrawer.Line(Left, Bottom, Left - Depth, Bottom + Depth);
ADrawer.Line(Left, Bottom, Left - scaled_depth, Bottom + scaled_depth);
end;
end;
@ -1274,26 +1278,28 @@ var
tries: Integer;
prevExt: TDoubleRect;
axis: TChartAxis;
scaled_depth: Integer;
begin
scaled_depth := ADrawer.Scale(Depth);
if not AxisVisible then begin
FClipRect.Left += Depth;
FClipRect.Bottom -= Depth;
FClipRect.Left += scaled_depth;
FClipRect.Bottom -= scaled_depth;
CalculateTransformationCoeffs(GetMargins(ADrawer));
exit;
end;
AxisList.PrepareGroups;
for axis in AxisList do
axis.PrepareHelper(ADrawer, Self, @FClipRect, Depth);
axis.PrepareHelper(ADrawer, Self, @FClipRect, scaled_depth);
// There is a cyclic dependency: extent -> visible marks -> margins.
// We recalculate them iteratively hoping that the process converges.
CalculateTransformationCoeffs(ZeroRect);
cr := FClipRect;
for tries := 1 to 10 do begin
axisMargin := AxisList.Measure(CurrentExtent, Depth);
axisMargin[calLeft] := Max(axisMargin[calLeft], Depth);
axisMargin[calBottom] := Max(axisMargin[calBottom], Depth);
axisMargin := AxisList.Measure(CurrentExtent, scaled_depth);
axisMargin[calLeft] := Max(axisMargin[calLeft], scaled_depth);
axisMargin[calBottom] := Max(axisMargin[calBottom], scaled_depth);
FClipRect := cr;
for aa := Low(aa) to High(aa) do
SideByAlignment(FClipRect, aa, -axisMargin[aa]);

View File

@ -149,7 +149,6 @@ type
procedure Assign(ASource: TPersistent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AddXOHLC(
AX, AOpen, AHigh, ALow, AClose: Double;
ALabel: String = ''; AColor: TColor = clTAColor): Integer; inline;
@ -180,21 +179,22 @@ type
property AxisIndexY;
property Source;
end;
(*
TCandleStickSeries = class(TOpenHighLowCloseSeries)
public
procedure Draw(ADrawer: IChartDrawer); override;
end;
*)
implementation
uses
Math, SysUtils, TACustomSource, TAGeometry, TAGraph, TAMath;
FPCanvas, Math, SysUtils, TACustomSource, TAGeometry, TAGraph, TAMath;
type
TLegendItemOHLCLine = class(TLegendItemLine)
strict private
FMode: TOHLCMode;
FCandleStickUpColor: TColor;
FCandleStickDownColor: TColor;
public
constructor Create(ASeries: TOpenHighLowCloseSeries; const AText: String);
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
end;
@ -214,17 +214,56 @@ type
{ TLegendItemOHLCLine }
procedure TLegendItemOHLCLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
constructor TLegendItemOHLCLine.Create(ASeries: TOpenHighLowCloseSeries; const AText: String);
var
dx, x, y: Integer;
pen: TFPCustomPen;
begin
case ASeries.Mode of
mOHLC : pen := ASeries.LinePen;
mCandleStick : pen := ASeries.CandleStickLinePen;
end;
inherited Create(pen, AText);
FMode := ASeries.Mode;
FCandlestickUpColor := ASeries.CandlestickUpBrush.Color;
FCandlestickDownColor := ASeries.CandlestickDownBrush.Color;
end;
procedure TLegendItemOHLCLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
const
TICK_LENGTH = 3;
var
dx, dy, x, y: Integer;
pts: array[0..3] of TPoint;
begin
inherited Draw(ADrawer, ARect);
y := (ARect.Top + ARect.Bottom) div 2;
dx := (ARect.Right - ARect.Left) div 3;
x := ARect.Left + dx;
ADrawer.Line(x, y, x, y + 2);
x += dx;
ADrawer.Line(x, y, x, y - 2);
case FMode of
mOHLC:
begin
dy := ADrawer.Scale(TICK_LENGTH);
ADrawer.Line(x, y, x, y + dy);
x += dx;
ADrawer.Line(x, y, x, y - dy);
end;
mCandlestick:
begin
dy := (ARect.Bottom - ARect.Top) div 4;
pts[0] := Point(x, y-dy);
pts[1] := Point(x, y+dy);
pts[2] := Point(x+dx, y+dy);
pts[3] := pts[0];
ADrawer.SetBrushParams(bsSolid, FCandlestickUpColor);
ADrawer.Polygon(pts, 0, 4);
pts[0] := Point(x+dx, y+dy);
pts[1] := Point(x+dx, y-dy);
pts[2] := Point(x, y-dy);
pts[3] := pts[0];
ADrawer.SetBrushParams(bsSolid, FCandlestickDownColor);
ADrawer.Polygon(pts, 0, 4);
end;
end;
end;
{ TLegendItemBoxAndWhiskers }
@ -780,7 +819,7 @@ end;
procedure TOpenHighLowCloseSeries.GetLegendItems(AItems: TChartLegendItems);
begin
AItems.Add(TLegendItemOHLCLine.Create(LinePen, LegendTextSingle));
AItems.Add(TLegendItemOHLCLine.Create(Self, LegendTextSingle));
end;
function TOpenHighLowCloseSeries.GetSeriesColor: TColor;
@ -865,85 +904,10 @@ begin
UpdateParentChart;
end;
(*
{ TCandleStickSeries }
procedure TCandleStickChart.Draw(ADrawer: IChartDrawer);
function MaybeRotate(AX, AY: Double): TPoint;
begin
if IsRotated then
Exchange(AX, AY);
Result := ParentChart.GraphToImage(DoublePoint(AX, AY));
end;
procedure DoLine(AX1, AY1, AX2, AY2: Double);
begin
ADrawer.Line(MaybeRotate(AX1, AY1), MaybeRotate(AX2, AY2));
end;
function GetGraphPointYIndex(AIndex, AYIndex: Integer): Double;
begin
if AYIndex = 0 then
Result := GetGraphPointY(AIndex)
else
Result := AxisToGraphY(Source[AIndex]^.YList[AYIndex - 1]);
end;
procedure DoRect(AX1, AY1, AX2, AY2: Double);
var
r: TRect;
begin
with ParentChart do begin
r.TopLeft := MaybeRotate(AX1, AY1);
r.BottomRight := MaybeRotate(AX2, AY2);
end;
ADrawer.FillRect(r.Left, r.Top, r.Right, r.Bottom);
ADrawer.Rectangle(r);
end;
var
maxy: Cardinal;
ext2: TDoubleRect;
i: Integer;
x, tw, yopen, yhigh, ylow, yclose: Double;
p: TPen;
begin
maxy := MaxIntValue([YIndexOpen, YIndexHigh, YIndexLow, YIndexClose]);
if IsEmpty or (maxy >= Source.YCount) then exit;
ext2 := ParentChart.CurrentExtent;
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
PrepareGraphPoints(ext2, true);
for i := FLoBound to FUpBound do begin
x := GetGraphPointX(i);
yopen := GetGraphPointYIndex(i, YIndexOpen);
yhigh := GetGraphPointYIndex(i, YIndexHigh);
ylow := GetGraphPointYIndex(i, YIndexLow);
yclose := GetGraphPointYIndex(i, YIndexClose);
tw := GetXRange(x, i) * PERCENT * TickWidth;
if (DownLinePen.Color = clTAColor) or (yopen <= yclose) then
p := LinePen
else
p := DownLinePen;
ADrawer.BrushColor:= P.Color;
// set border black
ADrawer.SetPenParams(p.Style, clBlack);
DoLine(x, yhigh, x, ylow);
DoRect(x - tw, yopen, x + tw, yclose);
end;
end;
*)
initialization
RegisterSeriesClass(TBubbleSeries, 'Bubble series');
RegisterSeriesClass(TBoxAndWhiskerSeries, 'Box-and-whiskers series');
RegisterSeriesClass(TOpenHighLowCloseSeries, 'Open-high-low-close series');
// RegisterSeriesClass(TCandleStickSeries, 'Candle stick series');
end.

View File

@ -236,6 +236,7 @@ var
i, numSteps: Integer;
p: array of TPoint;
a: Double;
scaled_depth: Integer;
begin
if IsEmpty then exit;
@ -244,15 +245,16 @@ begin
ADrawer.SetPen(EdgePen);
if Depth > 0 then begin
scaled_depth := ADrawer.Scale(Depth);
for ps in FSlices do begin
if not ps.FVisible then continue;
ADrawer.SetBrushParams(bsSolid, SliceColor(ps.FOrigIndex));
if not InRange(ps.FNextAngle, Pi / 4, 5 * Pi / 4) then
ADrawer.DrawLineDepth(
ps.FBase, ps.FBase + RotatePointX(FRadius, -ps.FNextAngle), Depth);
ps.FBase, ps.FBase + RotatePointX(FRadius, -ps.FNextAngle), scaled_depth);
if InRange(ps.FPrevAngle, Pi / 4, 5 * Pi / 4) then
ADrawer.DrawLineDepth(
ps.FBase, ps.FBase + RotatePointX(FRadius, -ps.FPrevAngle), Depth);
ps.FBase, ps.FBase + RotatePointX(FRadius, -ps.FPrevAngle), scaled_depth);
end;
for ps in FSlices do begin
if not ps.FVisible then continue;
@ -262,7 +264,7 @@ begin
for i := 0 to numSteps - 1 do begin
a := WeightedAverage(ps.FPrevAngle, ps.FNextAngle, i / (numSteps - 1));
p[i] := ps.FBase + RotatePointX(FRadius, -a);
p[High(p) - i] := p[i] + Point(Depth, -Depth);
p[High(p) - i] := p[i] + Point(scaled_depth, -scaled_depth);
end;
ADrawer.Polygon(p, 0, Length(p));
end;
@ -487,9 +489,11 @@ var
di: PChartDataItem;
prevAngle: Double = 0;
a, total: Double;
scaled_depth: Integer;
begin
Result.TopLeft := FCenter;
Result.BottomRight := FCenter;
scaled_depth := ADrawer.Scale(Depth);
SetLength(FSlices, Count);
j := 0;
// This is a workaround for db source invalidating the cache due to
@ -511,7 +515,7 @@ begin
ExpandRect(Result, FBase, FRadius, -FPrevAngle, -FNextAngle);
if Depth > 0 then
ExpandRect(
Result, FBase + Point(Depth, -Depth),
Result, FBase + Point(scaled_depth, -scaled_depth),
FRadius, -FPrevAngle, -FNextAngle);
FLabel.FAttachment := EndPoint(a, FRadius) + FBase;
PrepareLabel(FLabel, i, a);

View File

@ -146,7 +146,6 @@ type
procedure Assign(ASource: TPersistent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw(ADrawer: IChartDrawer); override;
function Extent: TDoubleRect; override;
published
@ -202,7 +201,6 @@ type
procedure Assign(ASource: TPersistent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw(ADrawer: IChartDrawer); override;
public
procedure BeginUpdate;
@ -494,6 +492,7 @@ var
i, j: Integer;
p, pPrev: TDoublePoint;
pNan, pPrevNan: Boolean;
scaled_depth: Integer;
begin
if LineType = ltNone then exit;
// For extremely long series (10000 points or more), the Canvas.Line call
@ -543,9 +542,10 @@ var
ADrawer.SetBrushParams(bsSolid, LinePen.Color);
ADrawer.SetPenParams(LinePen.Style, clBlack);
end;
scaled_depth := ADrawer.Scale(Depth);
for i := 0 to High(breaks) - 1 do
for j := breaks[i] to breaks[i + 1] - 2 do
ADrawer.DrawLineDepth(points[j], points[j + 1], Depth);
ADrawer.DrawLineDepth(points[j], points[j + 1], scaled_depth);
end;
end;
@ -950,6 +950,7 @@ end;
procedure TBarSeries.Draw(ADrawer: IChartDrawer);
var
pointIndex, stackIndex: Integer;
scaled_depth: Integer;
procedure DrawBar(const AR: TRect);
var
@ -978,9 +979,10 @@ var
ADrawer.Rectangle(AR);
if Depth = 0 then exit;
ADrawer.DrawLineDepth(AR.Left, AR.Top, AR.Right - 1, AR.Top, Depth);
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, Depth);
AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, scaled_depth);
end;
var
@ -1027,6 +1029,8 @@ begin
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
scaled_depth := ADrawer.Scale(Depth);
PrepareGraphPoints(ext2, true);
if IsRotated then
z := AxisToGraphX(ZeroLevel)
@ -1211,6 +1215,7 @@ procedure TAreaSeries.Draw(ADrawer: IChartDrawer);
var
pts: TPointArray;
numPts: Integer;
scaled_depth: Integer;
procedure PushPoint(const AP: TPoint); overload;
begin
@ -1304,7 +1309,7 @@ var
if Depth > 0 then
// Rendering is incorrect when values cross zero level.
for i := 1 to n2 - 2 do
ADrawer.DrawLineDepth(pts[i], pts[i + 1], Depth);
ADrawer.DrawLineDepth(pts[i], pts[i + 1], scaled_depth);
ADrawer.Polygon(pts, 0, numPts);
end;
if AreaLinesPen.Style <> psClear then begin
@ -1330,6 +1335,8 @@ begin
PrepareGraphPoints(ext, true);
if Length(FGraphPoints) = 0 then exit;
scaled_depth := ADrawer.Scale(Depth);
SetLength(pts, Length(FGraphPoints) * 4 + 4);
SetLength(prevPts, Length(pts));
j := -1;