paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 23:57:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Initial implementation of function series

Browse Source 
git-svn-id: trunk@19169 -
This commit is contained in:
ask 2009-03-31 06:48:48 +00:00
parent a395aebafc
commit 53478c37f8
3 changed files with 261 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
components/tachart/tagraph.pas
View File

@ -54,7 +54,7 @@ type
FActive: Boolean;
FShowInLegend: Boolean;
procedure AfterAdd; virtual; abstract;
procedure AfterAdd; virtual;
procedure DrawLegend(ACanvas: TCanvas; const ARect: TRect); virtual; abstract;
function GetLegendCount: Integer; virtual; abstract;
function GetLegendWidth(ACanvas: TCanvas): Integer; virtual; abstract;
@ -78,7 +78,7 @@ type
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
function Count: Integer; virtual; abstract;
function IsEmpty: Boolean; virtual; abstract;
procedure Draw(ACanvas: TCanvas); virtual; abstract;
property Active: Boolean read FActive write SetActive;
@ -219,9 +219,9 @@ type
procedure XGraphToImage(Xin: Double; out XOut: Integer);
procedure YGraphToImage(Yin: Double; out YOut: Integer);
function GraphToImage(AGraphPoint: TDoublePoint) : TPoint;
procedure XImageToGraph(XIn: Integer; var XOut: Double);
procedure YImageToGraph(YIn: Integer; var YOut: Double);
procedure ImageToGraph(XIn, YIn: Integer; var XOut, YOut: Double);
procedure XImageToGraph(XIn: Integer; out XOut: Double);
procedure YImageToGraph(YIn: Integer; out YOut: Double);
procedure ImageToGraph(XIn, YIn: Integer; out XOut, YOut: Double);
procedure DisplaySeries(ACanvas: TCanvas);
procedure ZoomFull;
@ -968,7 +968,8 @@ end;
procedure TChart.Refresh(ACanvas: TCanvas; ARect: TRect);
var
Tolerance, Valeur: Double;
i, pointsTotal: Integer;
i: Integer;
allEmpty: Boolean = true;
XMinSeries, XMaxSeries, YMinSeries, YMaxSeries: Double;
begin
DrawReticule(ACanvas);
@ -984,11 +985,10 @@ begin
XMaxSeries := MinDouble;
YMinSeries := MaxDouble;
YMaxSeries := MinDouble;
pointsTotal := 0;
for i := 0 to SeriesCount - 1 do
with Series[i] do
if Active then begin
pointsTotal += Count;
allEmpty := allEmpty and IsEmpty;
UpdateBounds(XMinSeries, YMinSeries, XMaxSeries, YMaxSeries);
end;
if XMinSeries > MaxDouble / 10 then XMinSeries := 0;
@ -1012,7 +1012,7 @@ begin
Tolerance := 0.001; //this should be cleaned eventually
// Tolerance := 0.1;
if pointsTotal > 0 then begin
if not allEmpty then begin
// If several points : automatic +/-10% of interval
Valeur := Tolerance * (XMaxSeries - XMinSeries);
if Valeur <> 0 then begin
@ -1067,17 +1067,17 @@ begin
YGraphToImage(AGraphPoint.Y, Result.Y);
end;
procedure TChart.XImageToGraph(XIn: Integer; var XOut: Double);
procedure TChart.XImageToGraph(XIn: Integer; out XOut: Double);
begin
XOut := (XIn - FOffset.X) / FScale.X;
end;
procedure TChart.YImageToGraph(YIn: Integer; var YOut: Double);
procedure TChart.YImageToGraph(YIn: Integer; out YOut: Double);
begin
YOut := (YIn - FOffset.Y) / FScale.Y;
end;
procedure TChart.ImageToGraph(XIn, YIn: Integer; var XOut, YOut: Double);
procedure TChart.ImageToGraph(XIn, YIn: Integer; out XOut, YOut: Double);
begin
XImageToGraph(XIn, XOut);
YImageToGraph(YIn, YOut);
@ -1404,6 +1404,11 @@ end;
{ TBasicChartSeries }
procedure TBasicChartSeries.AfterAdd;
begin
// nothing
end;
destructor TBasicChartSeries.Destroy;
begin
if FChart <> nil then

192
components/tachart/taseries.pas
View File

@ -78,9 +78,10 @@ type
function AddXY(X, Y: Double; XLabel: String; Color: TColor): Longint; virtual; overload;
function AddXY(X, Y: Double): Longint; virtual; overload;
procedure Clear;
function Count: Integer; override;
function Count: Integer;
procedure Delete(AIndex: Integer); virtual;
function FormattedMark(AIndex: integer): String;
function IsEmpty: Boolean; override;
published
property Active default true;
@ -289,6 +290,47 @@ type
property SeriesColor;
end;
TFuncCalculateEvent = procedure (const AX: Double; out AY: Double) of object;
{ TFuncSeries }
TFuncSeries = class(TBasicChartSeries)
private
FExtent: TChartExtent;
FOnCalculate: TFuncCalculateEvent;
FPen: TChartPen;
procedure SetExtent(const AValue: TChartExtent);
procedure SetOnCalculate(const AValue: TFuncCalculateEvent);
procedure SetPen(const AValue: TChartPen);
protected
procedure DrawLegend(ACanvas: TCanvas; const ARect: TRect); override;
function GetLegendCount: Integer; override;
function GetLegendWidth(ACanvas: TCanvas): Integer; override;
function GetSeriesColor: TColor; override;
procedure SetActive(AValue: Boolean); override;
procedure SetSeriesColor(const AValue: TColor); override;
procedure SetShowInLegend(AValue: Boolean); override;
procedure StyleChanged(Sender: TObject);
procedure UpdateBounds(var AXMin, AYMin, AXMax, AYMax: Double); override;
procedure UpdateParentChart;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw(ACanvas: TCanvas); override;
function IsEmpty: Boolean; override;
published
property Active default true;
property Extent: TChartExtent read FExtent write SetExtent;
property Pen: TChartPen read FPen write SetPen;
property OnCalculate: TFuncCalculateEvent read FOnCalculate write SetOnCalculate;
property ShowInLegend;
property Title;
end;
implementation
uses
@ -394,6 +436,11 @@ begin
Exchange(YMin, YMax);
end;
function TChartSeries.IsEmpty: Boolean;
begin
Result := Count = 0;
end;
function TChartSeries.AddXY(X, Y: Double; XLabel: String; Color: TColor): Longint;
var
pcc: PChartCoord;
@ -1508,11 +1555,154 @@ begin
ACanvas.LineTo(ARect.Right, y);
end;
{ TFuncSeries }
constructor TFuncSeries.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := true;
FExtent := TChartExtent.Create(FChart);
FShowInLegend := true;
FPen := TChartPen.Create;
FPen.OnChange := @StyleChanged;
end;
destructor TFuncSeries.Destroy;
begin
FExtent.Free;
FPen.Free;
inherited Destroy;
end;
procedure TFuncSeries.Draw(ACanvas: TCanvas);
function CalcY(AX: Integer): Integer;
var
xg, yg: Double;
begin
FChart.XImageToGraph(AX, xg);
OnCalculate(xg, yg);
yg := EnsureRange(yg, Extent.YMin, Extent.YMax);
FChart.YGraphToImage(yg, Result);
end;
var
x, xmax: Integer;
begin
if not Assigned(OnCalculate) then exit;
FChart.XGraphToImage(Extent.XMin, x);
x := Max(x, FChart.XImageMin);
FChart.XGraphToImage(Extent.XMax, xmax);
xmax := Min(xmax, FChart.XImageMax);
ACanvas.Pen.Assign(Pen);
ACanvas.MoveTo(x, CalcY(x));
while x < xmax do begin
Inc(x, 2);
ACanvas.LineTo(x, CalcY(x));
end;
end;
procedure TFuncSeries.DrawLegend(ACanvas: TCanvas; const ARect: TRect);
var
y: Integer;
begin
ACanvas.TextOut(ARect.Right + 3, ARect.Top, Title);
ACanvas.Pen.Assign(Pen);
y := (ARect.Top + ARect.Bottom) div 2;
ACanvas.MoveTo(ARect.Left, y);
ACanvas.LineTo(ARect.Right, y);
end;
function TFuncSeries.GetLegendCount: Integer;
begin
Result := 1;
end;
function TFuncSeries.GetLegendWidth(ACanvas: TCanvas): Integer;
begin
Result := ACanvas.TextWidth(Title);
end;
function TFuncSeries.GetSeriesColor: TColor;
begin
Result := FPen.Color;
end;
function TFuncSeries.IsEmpty: Boolean;
begin
Result := not Assigned(OnCalculate);
end;
procedure TFuncSeries.SetActive(AValue: Boolean);
begin
if FActive = AValue then exit;
FActive := AValue;
UpdateParentChart;
end;
procedure TFuncSeries.SetExtent(const AValue: TChartExtent);
begin
if FExtent = AValue then exit;
FExtent.Assign(AValue);
UpdateParentChart;
end;
procedure TFuncSeries.SetOnCalculate(const AValue: TFuncCalculateEvent);
begin
if FOnCalculate = AValue then exit;
FOnCalculate := AValue;
UpdateParentChart;
end;
procedure TFuncSeries.SetPen(const AValue: TChartPen);
begin
if FPen = AValue then exit;
FPen.Assign(AValue);
UpdateParentChart;
end;
procedure TFuncSeries.SetSeriesColor(const AValue: TColor);
begin
if FPen.Color = AValue then exit;
FPen.Color := AValue;
UpdateParentChart;
end;
procedure TFuncSeries.SetShowInLegend(AValue: Boolean);
begin
if FShowInLegend = AValue then exit;
FShowInLegend := AValue;
UpdateParentChart;
end;
procedure TFuncSeries.StyleChanged(Sender: TObject);
begin
UpdateParentChart;
end;
procedure TFuncSeries.UpdateBounds(var AXMin, AYMin, AXMax, AYMax: Double);
begin
if Extent.XMin < AXMin then AXMin := Extent.XMin;
if Extent.YMin < AYMin then AYMin := Extent.YMin;
if Extent.XMax > AXMax then AXMax := Extent.XMax;
if Extent.YMax > AYMax then AYMax := Extent.YMax;
end;
procedure TFuncSeries.UpdateParentChart;
begin
if ParentChart <> nil then
ParentChart.Invalidate;
end;
initialization
RegisterSeriesClass(TLineSeries, 'Line series');
RegisterSeriesClass(TAreaSeries, 'Area series');
RegisterSeriesClass(TBarSeries, 'Bar series');
RegisterSeriesClass(TPieSeries, 'Pie series');
RegisterSeriesClass(TFuncSeries, 'Function series');
RegisterSeriesClass(TLine, 'Line');
end.

53
components/tachart/tatypes.pas
View File

@ -238,6 +238,30 @@ type
property Visible default true;
end;
{ TChartExtent }
TChartExtent = class (TChartElement)
private
FExtent: TDoubleRect;
FAuto: array [1..4] of Boolean;
function GetAuto(AIndex: integer): Boolean;
function GetBorder(AIndex: Integer): Double;
procedure SetAuto(AIndex: Integer; AValue: Boolean);
procedure SetBorder(AIndex: Integer; const AValue: Double);
public
property Extent: TDoubleRect read FExtent;
published
property XMin: Double index 1 read GetBorder write SetBorder;
property YMin: Double index 2 read GetBorder write SetBorder;
property XMax: Double index 3 read GetBorder write SetBorder;
property YMax: Double index 4 read GetBorder write SetBorder;
property AutoXMin: Boolean index 1 read GetAuto write SetAuto;
property AutoYMin: Boolean index 2 read GetAuto write SetAuto;
property AutoXMax: Boolean index 3 read GetAuto write SetAuto;
property AutoYMax: Boolean index 4 read GetAuto write SetAuto;
end;
const
MARKS_MARGIN_X = 4;
MARKS_MARGIN_Y = 2;
@ -744,5 +768,34 @@ begin
StyleChanged(Self);
end;
{ TChartExtent }
function TChartExtent.GetAuto(AIndex: Integer): Boolean;
begin
Result := FAuto[AIndex];
end;
function TChartExtent.GetBorder(AIndex: Integer): Double;
var
a: array [1..4] of Double absolute FExtent;
begin
Result := a[AIndex];
end;
procedure TChartExtent.SetAuto(AIndex: Integer; AValue: Boolean);
begin
FAuto[AIndex] := AValue;
StyleChanged(Self);
end;
procedure TChartExtent.SetBorder(AIndex: Integer; const AValue: Double);
var
a: array [1..4] of Double absolute FExtent;
begin
a[AIndex] := AValue;
StyleChanged(Self);
end;
end.