mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-03 02:59:51 +01:00
TAChart: Fix several bugs related to incorrect scaling for printing
git-svn-id: trunk@47203 -
This commit is contained in:
parent
8a48485cac
commit
01cb0be6e0
@ -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;
|
||||
|
||||
@ -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]);
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user