home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 October
/
Chip_2001-10_cd1.bin
/
zkuste
/
delphi
/
kompon
/
d123456
/
CHEMPLOT.ZIP
/
TPlot
/
Data.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-07-26
|
150KB
|
4,674 lines
unit Data;
{$I Plot.inc}
{-----------------------------------------------------------------------------
The contents of this file are subject to the Q Public License
("QPL"); you may not use this file except in compliance
with the QPL. You may obtain a copy of the QPL from
the file QPL.html in this distribution, derived from:
http://www.trolltech.com/products/download/freelicense/license.html
The QPL prohibits development of proprietary software.
There is a Professional Version of this software available for this.
Contact sales@chemware.hypermart.net for more information.
Software distributed under the QPL is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the QPL for
the specific language governing rights and limitations under the QPL.
The Original Code is: pSeries.pas, released 12 September 2000.
The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.
Contributor(s): Mat Ballard e-mail: mat.ballard@chemware.hypermart.net.
Last Modified: 04/09/2000
Current Version: 2.00
You may retrieve the latest version of this file from:
http://Chemware.hypermart.net/
This work was created with the Project JEDI VCL guidelines:
http://www.delphi-jedi.org/Jedi:VCLVCL
in mind.
Purpose:
This unit contains the TSeries sub-component - that manages the data for a single series.
Known Issues:
- This would normally be called Series, but TeeChart already uses that unit name.
History:
1.20 15 Jan 2001: change name from pSeries to Data: TChart uses Series, but
'Data' is what this unit manages.
many changes to accomodate new plot types.
1.01 21 September 2000: add Brush property for columns
-----------------------------------------------------------------------------}
interface
uses
Classes, SysUtils,
{$IFDEF WINDOWS}
Wintypes,
Clipbrd, Controls, Dialogs, Forms, Graphics,
{$ENDIF}
{$IFDEF WIN32}
Windows,
Clipbrd, Controls, Dialogs, Forms, Graphics,
{$ENDIF}
{$IFDEF LINUX}
Types,
QClipbrd, QControls, QDialogs, QForms, QGraphics,
{$ENDIF}
{$IFNDEF NO_MATH}
Math,
{$ENDIF}
Axis, Dataedit, Displace, NoMath, PlotDefs, Ptedit, Misc;
const
OUTLINE_DENSITY = 20;
{This is the number of points in a branch of an Outline.}
type
//TOnMinMaxChangeEvent = procedure(Sender: TObject; Value: Single) of object;
THighLow = (hlLow, hlHigh);
TSetHighLow = set of THighLow;
TDataStatus = (dsNone, dsInternal, dsInternalString, dsExternal);
{These are the data storage states:}
{}
{ dsNone - no data as yet;}
{ dsInternal - there is internal memory;}
{ dsInternalString - there is internal memory, with string X values;}
{ dsExternal - both the X and Y data are stored elsewhere (not in this component).}
{$IFDEF DELPHI1}
EAccessViolation = class(Exception);
{$ENDIF}
TSeries = class(TPersistent)
private
FAxisList: TList;
FBrush: TBrush;
//FDataChanged: Boolean;
FDefSize: Word;
FDeltaX: Integer;
FDeltaY: Integer;
FName: String;
FNoPts: Integer;
FPen: TPen;
FHighCapacity: Integer;
FHighCount: Integer;
FHighLow: TSetHighLow;
FHighs: pIntegerArray;
FLowCount: Integer;
FLows: pIntegerArray;
FShadeLimits: Boolean;
FSymbol: TSymbol;
FSymbolSize: Integer;
FVisible: Boolean;
FXAxis: TAxis;
FXMin: Single;
FXMax: Single;
FXData: pSingleArray;
FXStringData: TStringList;
FYAxis: TAxis;
FYAxisIndex: Byte;
FYData: pSingleArray;
FZData: Single;
Fd2Y_dX2: pSingleArray;
Size2ndDeriv: Integer;
FYMin: Single;
FYMax: Single;
{The bounding rectangle for a Pie, which is stored:}
//PieLeft, PieTop, Width, Height: Longint;
{The sum of Y values: used in Pie graphs}
YSum: Single;
FOnStyleChange: TNotifyEvent;
FOnDataChange: TNotifyEvent;
{FOnAddPoint: TNotifyEvent;}
{Currently superceded by direct calls to TAxis.SetMin[Max]FromSeries:}
{FOnXMinChange: TOnMinMaxChangeEvent;
FOnXMaxChange: TOnMinMaxChangeEvent;
FOnYMinChange: TOnMinMaxChangeEvent;
FOnYMaxChange: TOnMinMaxChangeEvent;}
{may be re-implemented later for other needs.}
FDependentSeries: TList;
{The list of series that use this series' X-Data.}
FExternalXSeries: Boolean;
{Is the X data maintained in a different series ?}
FXDataSeries: TSeries;
{This is the Data Series in which the External X data, if any, is stored.}
DataStatus: TDataStatus;
{Was this data generated externally ? If it was, then we do not manage it,
nor manipulate it.}
MemSize: LongInt;
{The current number of points allocated in memory.}
TheOutline: array [0..OUTLINE_DENSITY+1] of TPoint;
{An array of Outline points. These points are in screen co-ordinates (pixels).}
{}
{The Outline is used for clicking and dragging operations.}
{}
{Note that for XY-type series, the Outline is a series of points,
but for Pie series, the first two are (Top, Left), (Right, Bottom).}
NoOutlinePts: Integer;
{The number of Outline points.}
//FOutlineWidth: Integer;
{This is the width of the Outline.}
procedure CheckBounds(ThePointNo: Integer; AdjustAxis: Boolean);
{Check the Min and Max properties against this point.}
function IncMemSize: Boolean;
{Allocate memory for the data.}
protected
{The one and only property getting function:}
function GetXDataRefCount: Word;
{The property-setting routines:}
procedure SetBrush(Value: TBrush);
procedure SetDeltaX(Value: Integer);
procedure SetDeltaY(Value: Integer);
procedure SetName(Value: String);
procedure SetPen(Value: TPen);
procedure SetShadeLimits(Value: Boolean);
procedure SetSymbol(Value: TSymbol);
procedure SetSymbolSize(Value: Integer);
procedure SetVisible(Value: Boolean);
procedure SetXStringData(Value: TStringList);
procedure SetYAxisIndex(Value: Byte);
procedure SetZData(Value: Single);
procedure DoStyleChange;
procedure DoDataChange;
public
//property DataChanged: Boolean read FDataChanged write FDataChanged;
{Has the data in this series changed ?}
property ExternalXSeries: Boolean read FExternalXSeries;
{Is the X data maintained in a different series ?}
property XDataSeries: TSeries read FXDataSeries;
{If the X data is maintained in a different series, this is the series.}
property NoPts: Integer read FNoPts;
{The number of points in the series.}
property HighCount: Integer read FHighCount;
{The number of Highs (Peaks)}
property Highs: pIntegerArray read FHighs;
{This is a list of the Highs (Peaks) in the plot. See Lows.}
property LowCount: Integer read FLowCount;
{The number of Lows (Troughs)}
property Lows: pIntegerArray read FLows;
{This is a list of the Lows (Troughs) in the plot. See Highs.}
property XDataRefCount: Word read GetXDataRefCount;
{This is the number of series that use this series as an X Data holder.}
property XAxis: TAxis read FXAxis;
{The X Axis to which this series is bound - needed for scaling purposes.}
property YAxis: TAxis read FYAxis;
{The Y Axis to which this series IS bound - can be any of the Y Axes - needed for scaling purposes.}
property YAxisIndex: Byte read FYAxisIndex write SetYAxisIndex;
{The Y Axis Index to which this series IS bound - can be any of the Y Axes - needed for scaling purposes.
We define YAxisIndex to run from 1 to FAxisList.Count-1:
1 => The primary Y Axis,
2 => The secondary Y Axis,
etc.}
property XData: pSingleArray read FXData;
{This is the dynamic X data array.
It can be set by the user, or memory for the data
can be allocated and managed by this component.}
{}
{The user can access the data points either through the GetPoint / GetXYPoint /
ReplacePoint methods, or directly by:}
{}
{ ASeries.FXData^[i] := NewValue;}
{}
{Note that the POINTER XData is read-only, but that the array elements are
read/write.}
property XStringData: TStringlist read FXStringData write SetXStringData;
{This is the X data in string format.}
property YData: pSingleArray read FYData;
{This is the dynamic Y data array.
It can be set by the user, or memory for the data
can be allocated and managed by this component.}
{}
{The user can access the data points either through the GetPoint / GetXYPoint /
ReplacePoint methods, or directly by:}
{}
{ ASeries.FYData^[i] := NewValue;}
{}
{Note that the POINTER YData is read-only, but that the array elements are
read/write.}
property ZData: Single read FZData write SetZData;
{This is the Z-value for this series.
It is set by the user.}
{}
{Note that unlike the read-only POINTERS XData and YData,
ZData is a single read/write value.}
property d2Y_dX2: pSingleArray read Fd2Y_dX2;
{The array of second derivatives - used in cubic splines.}
property XMin: Single read FXMin;
{The minimum X value, determined by GetBounds.}
property XMax: Single read FXMax;
{The maximum X value, determined by GetBounds.}
property YMin: Single read FYMin;
{The minimum Y value, determined by GetBounds.}
property YMax: Single read FYMax;
{The maximum Y value, determined by GetBounds.}
Constructor Create(
Index: Integer;
AxisList: TList;
XDataSeriesValue: TSeries); virtual;
{Each series needs to know a few things:}
{}
{ 1. What axes it can relate to;}
{ 2. Does it use another (previous) series X Values ?}
Destructor Destroy; override;
{The following Addxxx methods are now overloaded to add error and 3D functionality.}
function AddData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean;
{This adds an entire Internal data set of an X array, a Y array,
and the new number of points: Success returns TRUE.}
{}
{Internal means that TSeries allocates and manages the memory for this data,
and makes a copy of the data located at XPointer and YPointer into this
internally managed memory.}
{}
{It can therefore add, remove or edit any points.}
function AddDrawPoint(X, Y: Single; ACanvas: TCanvas): Integer;
{This adds a single point to the xy data (using AddPoint),
draws the line segment and new point, and returns the number
of points: -1 indicates failure.}
function AddPoint(X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer;
{This adds a single point to the xy data and returns the number of points:
-1 indicates failure. If no memory has been allocated for the data yet, then
IncMemSize is called automatically.}
function AddStringPoint(XString: String; X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer;
{This adds a single point, which has a string X value, to the data and returns
the number of points: -1 indicates failure. If no memory has been allocated
for the data yet, then IncMemSize is called automatically.}
function InsertPoint(X, Y: Single): Integer;
{This inserts a single point in the xy data and returns the location of the point:
-1 indicates failure. The point is inserted at the appropriate X value.}
function PointToData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean;
{This adds an entire External data set of an X array, a Y array,
and the new number of points: Success returns TRUE.}
{}
{External means that TSeries does not manage the memory for this data,
nor can it add, remove or edit any points.}
procedure ReplacePoint(N: Integer; NewX, NewY: Single);
{This replaces the Nth point's values with X and Y.}
{These are the overloaded Addxxx methods to add error and 3D functionality.}
{function AddData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean; overload;
function AddDrawPoint(X, Y: Single; ACanvas: TCanvas): Integer; overload;
function AddPoint(X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer; overload;
function AddStringPoint(XString: String; X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer; overload;
function InsertPoint(X, Y: Single): Integer; overload;
function PointToData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean; overload;
procedure ReplacePoint(N: Integer; NewX, NewY: Single); overload;}
function AllocateNoPts(Value: LongInt): Boolean;
{Directly allocates memory for a fixed number of points.}
{}
{If AllocateNoPts cannot allocate memory for the requested number of points,
it allocates what it can and returns FALSE.}
procedure Compress(CompressRatio: Integer);
{This averages every N points in a row and so reduces the size of the
data set by a factor of N.}
procedure Contract(TheStart, TheFinish: Integer);
{This throws away all points before TheStart and after TheFinish.}
procedure CopyToClipBoard;
{Does what it says.}
procedure Displace(TheHelpFile: String);
{Runs the dialog box to set the displacement (DeltaX) of the Series.}
procedure ApplyDisplacementChange(Sender: TObject);
{This applies changes from the Displacement Dialog.}
function AddDependentSeries(ASeries: TSeries): Boolean;
{This function ADDS a series that depends on this series' X-Data from the list of dependent series.}
function RemoveDependentSeries(ASeries: TSeries): Boolean;
{This function REMOVES a series that depends on this series' X-Data from the list of dependent series.}
function AssumeMasterSeries(XPts: Integer; OldMaster: TSeries; AList: TList): Boolean;
{This function makes this series' X-Data the MASTER for the given list of dependent series.}
function ResetXDataSeries(OldSeries, NewSeries: TSeries): Boolean;
function DelPoint(X, Y: Single; Confirm: Boolean): Integer;
{This deletes a single point, the closest one, from the xy data.}
function DelPointNumber(ThePoint: Integer; Confirm: Boolean): Integer;
{This deletes a single point, the Nth one, from the xy data.}
function DelData: Boolean;
{This deletes an entire data set. It only works on internal data sets.}
procedure DrawHistory(ACanvas: TCanvas; HistoryX: Single);
{This draws the series on the given canvas, in History mode.
That is, from the latest point backwards a distance HistoryX}
procedure Draw(ACanvas: TCanvas; XYFastAt: Integer);
{This draws the series in XY fashion on the given canvas.}
procedure DrawShades(ACanvas: TCanvas; XYFastAt: Integer);
{This shades the series in XY fashion on the given canvas, if the Axis Limits are exceeded.}
procedure DrawPie(ACanvas: TCanvas; PieLeft, PieTop, PieWidth, PieHeight: Integer);
{This draws the series on the given canvas as a Pie.}
procedure DrawPolar(ACanvas: TCanvas; PolarRange: Single);
{This draws the series in Polar fashion on the given canvas.}
procedure DrawSymbol(ACanvas: TCanvas; iX, iY: Integer);
{This draws one of the symbols on the given canvas.}
procedure Trace(ACanvas: TCanvas);
{This draws the series on the given canvas in an erasable mode.
The first call draws, the second call erases.}
procedure EditData(TheHelpFile: String);
{This runs the Data Editor dialog box.}
procedure ApplyDataChange(Sender: TObject);
{This applies changes from the DataEditor Dialog.}
procedure EditPoint(ThePointNumber: Integer; TheHelpFile: String);
{This runs the Point Editor dialog box.}
procedure ApplyPointChange(Sender: TObject; TheResult: TModalResult);
{This applies changes from the PointEditor Dialog.}
procedure GetBounds;
{Determines the Min and Max properties for the whole series.}
{Data manipulation:}
procedure ResetBounds;
{Reset the Min and Max properties.}
function GetNearestPointToX(X: Single): Integer;
{This returns the point that has an X value closest to X.}
function GetNearestPointToFX(FX: Integer): Integer;
{This returns the point that has an F(X) / Screen value closest to FX.}
function GetNearestPieSlice(
iX, iY,
PieLeft, PieTop, PieWidth, PieHeight: Integer;
var MinDistance: Single): Integer;
{This returns the Index of the nearest point, and sets its XValue and YValue.}
function GetNearestXYPoint(
iX, iY, StartPt, EndPt: Integer;
var MinDistance: Single): Integer;
{This returns the Index of the nearest point, and sets its XValue and YValue.
It is guaranteed to find the nearest point.}
function GetNearestXYPointFast(
iX, iY: Integer;
var MinDistance: Single): Integer;
{This returns the Index of the nearest point, and sets its XValue and YValue.
This is much quicker than GetNearestXYPoint, especially for big data sets,
but MAY NOT return the closest point.}
procedure GetPoint(N: Integer; var X, Y: Single);
{This returns the Nth point's X and Y values.}
function GetXYPoint(N: Integer): TXYPoint;
{This returns the Nth point's X and Y values in a TXYPoint record.}
procedure Smooth(SmoothOrder: Integer);
{This smooths the xy data using a midpoint method.}
procedure Sort;
{This sorts the xy data in ascending X order.}
procedure GeneratePieOutline(
PieLeft,
PieTop,
PieWidth,
PieHeight,
TheNearestPoint: Integer);
{This generates an pIE Outline from the data, for the specified point/rectangle.}
procedure GenerateColumnOutline(X1, Y1, X2, Y2: Integer);
{This generates an Column Outline from the data, for the specified point/rectangle.}
procedure GenerateXYOutline;
{This generates an XY Outline from the data. An Outline contains
the screen coordinates for (OUTLINE_DENSITY +1) points.}
{}
{Note that the memory for the Outline is allocated in the constructor and
freed in the destructor.}
procedure Outline(ACanvas: TCanvas; ThePlotType: TPlotType; TheOutlineWidth: Integer);
{This draws (or erases) the Outline on the canvas.}
procedure MoveBy(ACanvas: TCanvas; ThePlotType: TPlotType; DX, DY, TheOutlineWidth: Integer);
{This erases the old Outline from the canvas, then redraws it
at (DX, DY) from its current position.}
procedure MoveTo(
ACanvas: TCanvas;
ThePlotType: TPlotType;
TheOutlineWidth,
X, Y: Integer); {by how much}
{This erases the old Outline from the canvas, then redraws it
at the new location (X, Y).}
procedure LineBestFit(TheLeft, TheRight: Single;
var NoLSPts: Integer;
var SumX, SumY, SumXsq, SumXY, SumYsq: Double;
var Slope, Intercept, Rsq: Single);
{This performs a linear least-squares fit of TheSeries from points Start to Finish,
and returns the Slope, Intercept and R-Square value.}
{}
{Normally you would initialize NoPts and the Sumxxx variables to zero.}
{}
{However, if you wish to fit over multiple regions (very useful in determining baselines)
then simply call this function twice in a row with no re-initialization between calls.}
procedure Differentiate;
{This replaces the series by its differential.}
procedure Integrate;
{This replaces the series by its integral.}
function Integral(TheLeft, TheRight: Single): Single;
{This calculates the integral of a series by X co-ordinate.}
function IntegralByPoint(Start, Finish: Integer): Single;
{This calculates the integral of a series by points.}
procedure DoSpline(Density: Integer; pSplineSeries: TSeries);
{This calculates the cubic spline interpolation of the data (XSpline, YSpline),
which resides in another Series.}
procedure SecondDerivative;
{This calculates the second derivate for a cubic spline interpolation by SplineValue.}
function SplineValue(X: Single): Single;
{This calculates the cubic spline interpolation of the data at a given point X.}
procedure ClearSpline;
function FindHighsLows(Start, Finish, HeightSensitivity: Integer): Integer;
procedure MovingAverage(Span: Integer);
function Average(TheLeft, TheRight: Single): Single;
procedure Linearize(TheLeft, TheRight: Single);
procedure Zero(TheLeft, TheRight: Single);
procedure ClearHighsLows;
procedure DrawHighs(ACanvas: TCanvas);
procedure MakeXDataIndependent;
published
property Brush: TBrush read FBrush write SetBrush;
{The Brush (color, width, etc) with which the series is drawn on the Canvas.}
property DeltaX: Integer read FDeltaX write SetDeltaX;
{The displacement of the series on the screen from its X origin.}
property DeltaY: Integer read FDeltaY write SetDeltaY;
{The displacement of the series on the screen from its Y origin.}
property DefSize: Word read FDefSize write FDefSize;
{The default memory allocation block size. Allocated memory grows in blocks of
this number of points.}
property HighLow: TSetHighLow read FHighLow write FHighLow;
{Do we show any Highs ? any Lows ? Both ? or None ?}
property Name: String read FName write SetName;
{The name of the data set.}
property Pen: TPen read FPen write SetPen;
{The Pen (color, width, etc) with which the series is drawn on the Canvas.}
property ShadeLimits: Boolean read FShadeLimits write SetShadeLimits;
{Do we shade this series above and below the Y-axis limits ?}
property Symbol: TSymbol read FSymbol write SetSymbol;
{The symbol (square, circle, etc) with which each data point is drawn.}
property SymbolSize: Integer read FSymbolSize write SetSymbolSize;
{How big is the Symbol (0 means invisible).}
property Visible: Boolean read FVisible write SetVisible;
{Is this series visible ?}
property OnStyleChange: TNotifyEvent read FOnStyleChange write FOnStyleChange;
{This notifies the owner (usually TSeriesList) of a change in style of this series.}
property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
{This notifies the owner (usually TSeriesList) of a change in the data of this series.}
{property OnXMinChange: TOnMinMaxChangeEvent read FOnXMinChange write FOnXMinChange;
property OnXMaxChange: TOnMinMaxChangeEvent read FOnXMaxChange write FOnXMaxChange;
property OnYMinChange: TOnMinMaxChangeEvent read FOnYMinChange write FOnYMinChange;
property OnYMaxChange: TOnMinMaxChangeEvent read FOnYMaxChange write FOnYMaxChange;}
{property OnAddPoint: TNotifyEvent read FOnAddPoint write FOnAddPoint;}
end;
function Compare(Item1, Item2: Pointer): Integer;
implementation
uses
Plot;
{TSeries Constructor and Destructor:-------------------------------------------}
{------------------------------------------------------------------------------
Constructor: TSeries.Create
Description: standard Constructor
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: creates Pen and initializes many things
Known Issues:
------------------------------------------------------------------------------}
Constructor TSeries.Create(
Index: Integer;
AxisList: TList;
XDataSeriesValue: TSeries);
begin
{First call the ancestor:}
inherited Create;
{create sub-components:}
FBrush := TBrush.Create;
//FBrush.Bitmap := nil;
FPen := TPen.Create;
FPen.Width := 1;
{we insert the default values that cannot be "defaulted":}
DataStatus := dsNone;
FDefSize := 256;
FDeltaX := 0;
FDeltaY := 0;
FNoPts := 0;
FYAxisIndex := 1;
{FVisible := TRUE;}
{Set axes:}
FAxisList := AxisList;
FXAxis := TAxis(AxisList[0]);
FYAxis := TAxis(AxisList[1]);
FSymbolSize := 5;
FDependentSeries := TList.Create;
FXDataSeries := XDataSeriesValue;
if (FXDataSeries = nil) then
begin
FExternalXSeries := FALSE;
FXData := nil;
end
else
begin
FExternalXSeries := TRUE;
FXData := FXDataSeries.XData;
FXDataSeries.AddDependentSeries(Self);
end;
FXStringData := nil;
{set names and color:}
FName := Format(sSeries + ' %d', [Index]);
FPen.Color := MyColorValues[Index mod 16];
{make the brush color paler by 70%:}
FBrush.Color := Misc.GetPalerColor(FPen.Color, 70);
FYData := nil;
MemSize := 0;
Fd2Y_dX2 := nil;
FHighs := nil;
FLows := nil;
FHighCount := 0;
FLowCount := 0;
FHighCapacity := 0;
FVisible := TRUE;
{allocate memory so as to create X and Y pointers:
IncMemSize; - not needed: done in AddPoint}
end;
{------------------------------------------------------------------------------
Destructor: TSeries.Destroy
Description: standard Destructor
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Frees Pen and events
Known Issues: would like a better solution to FXDataRefCount
------------------------------------------------------------------------------}
Destructor TSeries.Destroy;
begin
FOnStyleChange := nil;
FOnDataChange := nil;
FVisible := FALSE;
ClearSpline;
ClearHighsLows;
FBrush.Free;
FPen.Free;
if (FXDataSeries <> nil) then
FXDataSeries.RemoveDependentSeries(Self);
if (FXStringData <> nil) then
XStringData := nil;
DelData;
FDependentSeries.Free;
{then call ancestor:}
inherited Destroy;
end;
{Begin Set and Get Functions and Procedures----------------------------------}
{------------------------------------------------------------------------------
Procedure: TSeries.SetBrush
Description: property Setting procedure
Author: Mat Ballard
Date created: 09/21/2000
Date modified: 09/21/2000 by Mat Ballard
Purpose: sets the Brush Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetBrush(Value: TBrush);
begin
FBrush.Assign(Value);
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetDeltaX
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the DeltaX displacement Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetDeltaX(Value: Integer);
begin
if (FDeltaX = Value) then exit;
FDeltaX := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetDeltaY
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the DeltaY displacement Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetDeltaY(Value: Integer);
begin
if (FDeltaY = Value) then exit;
FDeltaY := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetName
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the Name Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetName(Value: String);
begin
if (FName = Value) then exit;
FName := Value;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetPen
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the Pen Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetPen(Value: TPen);
begin
FPen.Assign(Value);
DoStyleChange;
end;
procedure TSeries.SetShadeLimits(Value: Boolean);
begin
FShadeLimits := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetXStringData
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the XStringData: the X data as text strings
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetXStringData(Value: TStringList);
procedure NukeStringList;
begin
if (FXStringData <> nil) then
begin
FXStringData.Free;
FXStringData := nil;
end;
FXAxis.SetLabelSeries(nil);
DataStatus := dsInternal;
exit;
end;
begin
if (Value = nil) then
begin
NukeStringList;
exit;
end;
if (Value.Count = 0) then
begin
NukeStringList;
exit;
end;
if (FXStringData = nil) then
FXStringData := TStringList.Create;
if (DataStatus = dsInternal) then
DataStatus := dsInternalString;
if (Value.Count <> FNoPts) then
ShowMessage(Format(sSetXStringDataWarning,
[FNoPts, Value.Count]));
FXStringData.Clear;
FXStringData.Assign(Value);
FXAxis.SetLabelSeries(Self);
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetSeriesType
Description: property Setting procedure
Author: Mat Ballard
Date created: 12/15/2000
Date modified: 12/15/2000 by Mat Ballard
Purpose: sets the SeriesType Property
Known Issues:
------------------------------------------------------------------------------}
{procedure TSeries.SetSeriesType(Value: TSeriesType);
begin
if (FNoPts > 0) then raise
EComponentError.Create(Self.FName + ': you MUST Clear a Series before you can change its type !');
SeriesType := Value;
end;}
{------------------------------------------------------------------------------
Procedure: TSeries.SetSymbol
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the Symbol Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetSymbol(Value: TSymbol);
begin
if (FSymbol = Value) then exit;
FSymbol := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetSymbolSize
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the SymbolSize Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetSymbolSize(Value: Integer);
begin
if ((FSymbolSize = Value) or (FSymbolSize < 0)) then exit;
FSymbolSize := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetVisible
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the Visible Property
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SetVisible(Value: Boolean);
begin
{Can't become visible if Axes or Data have not been set:}
if ((FXAxis = nil) or (FYAxis = nil)) then raise
EInvalidPointer.CreateFmt('TSeries.SetVisible: ' + sSetVisible1 +
CRLF + '(X: %p; Y: %p)', [FXAxis, FYAxis]);
FVisible := Value;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SetYAxisIndex
Description: property Setting procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the YAxis Property
Known Issues: We define YAxisIndex to run from 1 to FAxisList.Count-1
------------------------------------------------------------------------------}
procedure TSeries.SetYAxisIndex(Value: Byte);
begin
if ((Value < 1) or
(Value >= FAxisList.Count)) then raise
ERangeError.Create('TSeries.SetYAxisIndex: ' + sSetYAxisIndex1);
FYAxisIndex := Value;
FYAxis := TAxis(FAxisList[Value]);
FYAxis.Visible := TRUE;
end;
procedure TSeries.SetZData(Value: Single);
begin
if (FZData = Value) then exit;
FZData := Value;
DoDataChange;
end;
{end Set procedures, begin general procedures ---------------------------------}
{------------------------------------------------------------------------------
Function: TSeries.AllocateNoPts
Description: allocates memory for data points
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: memory management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AllocateNoPts(Value: LongInt): Boolean;
var
Msg: String;
begin
AllocateNoPts := FALSE;
if (Value < 0) then
exit;
try
{$IFDEF DELPHI1} {Delphi 1 can only allocate 64K chunks locally:}
if ((Value) * SizeOf(Single) > 65535) then
begin
Value := 65535 div SizeOf(Single);
ShowMessage(Format('Running out of memory - can only allocate %d points', [Value]));
AllocateNoPts := FALSE;
end;
{$ENDIF}
if (FExternalXSeries) then
begin
{we don't allocate memory for X data that is held in a different series:}
FXData := Self.FXDataSeries.XData
{doesn't hurt, but should not be neccessary.}
end
else
{$IFDEF DELPHI1}
begin
if (FXData = nil) then
GetMem(FXData, Value * SizeOf(Single))
else
ReAllocMem(FXData, MemSize * SizeOf(Single), Value * SizeOf(Single));
end;
if (FYData = nil) then
GetMem(FYData, Value * SizeOf(Single))
else
ReAllocMem(FYData, MemSize * SizeOf(Single), Value * SizeOf(Single));
{$ELSE}
begin
ReAllocMem(FXData, Value * SizeOf(Single));
end;
ReAllocMem(FYData, Value * SizeOf(Single));
{$ENDIF}
AllocateNoPts := TRUE;
except
Msg := Format(sAllocateNoPts2,
[FName, Value, Value * SizeOf(Single)]);
ShowMessage(Msg);
raise;
end;
MemSize := Value;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DoStyleChange
Description: Fires the OnStyleChange event
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: event handling
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DoStyleChange;
begin
if (Assigned(FOnStyleChange) and Visible) then OnStyleChange(Self);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DoDataChange
Description: Fires the OnDataChange event
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: event handling
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DoDataChange;
begin
if (Assigned(FOnDataChange)) then OnDataChange(Self);
end;
{Data manipulation Functions and Procedures----------------------------------}
{------------------------------------------------------------------------------
Function: TSeries.AddData
Description: adds data from an externally-managed array
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AddData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean;
var
i: Integer;
begin
{clear any existing data:}
if (FNoPts > 0) then DelData;
try
{Allocate memory:}
AllocateNoPts(NumberOfPoints + FDefSize);
{NB: this causes terminal access violations:
System.Move(XPointer, FXData, NumberOfPoints * SizeOf(Single));}
if (not FExternalXSeries) then
begin
for i := 0 to NumberOfPoints-1 do
FXData^[i] := XPointer^[i];
end;
for i := 0 to NumberOfPoints-1 do
FYData^[i] := YPointer^[i];
DataStatus := dsInternal;
FNoPts := NumberOfPoints;
{find the new min and max:}
GetBounds; {which calls ResetBounds}
DoDataChange;
AddData := TRUE;
except
AddData := FALSE;
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.MakeXDataIndependent
Description: This procedure makes an internal copy of external X Data
Author: Mat Ballard
Date created: 08/31/2000
Date modified: 08/31/2000 by Mat Ballard
Purpose: series management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.MakeXDataIndependent;
var
i: Integer;
pOldXData: pSingleArray;
Msg: String;
begin
if (not FExternalXSeries) then exit;
pOldXData := FXData;
try
{$IFDEF DELPHI1}
GetMem(FXData, MemSize * SizeOf(Single));
{$ELSE}
ReAllocMem(FXData, MemSize * SizeOf(Single));
{$ENDIF}
{NB: the following generates gross access violations:
System.Move(pOldXData, FXData, FNoPts * SizeOf(Single));}
for i := 0 to FNoPts-1 do
FXData^[i] := pOldXData^[i];
FXDataSeries.RemoveDependentSeries(Self);
FExternalXSeries := FALSE;
except
Msg := Format(sAllocateNoPts2,
[FName, MemSize, MemSize * SizeOf(Single)]);
ShowMessage(Msg);
raise;
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.AddDependentSeries
Description: This function ADDS a series that depends on this series' X-Data from the list of dependent series.
Author: Mat Ballard
Date created: 08/25/2000
Date modified: 08/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AddDependentSeries(ASeries: TSeries): Boolean;
{var
pASeries: Pointer;}
begin
if (FDependentSeries.IndexOf(ASeries) < 0) then
begin
FDependentSeries.Add(ASeries);
AddDependentSeries := TRUE;
end
else
AddDependentSeries := FALSE;
end;
{------------------------------------------------------------------------------
Function: TSeries.RemoveDependentSeries
Description: This function REMOVES a series that depends on this series' X-Data from the list of dependent series.
Author: Mat Ballard
Date created: 08/25/2000
Date modified: 08/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.RemoveDependentSeries(ASeries: TSeries): Boolean;
{var
pASeries: Pointer;}
begin
if (FDependentSeries.IndexOf(ASeries) >= 0) then
begin
FDependentSeries.Remove(ASeries);
RemoveDependentSeries := TRUE;
end
else
RemoveDependentSeries := FALSE;
end;
{------------------------------------------------------------------------------
Function: TSeries.GetXDataRefCount
Description: This function returns the number of dependent series
Author: Mat Ballard
Date created: 08/25/2000
Date modified: 08/25/2000 by Mat Ballard
Purpose: data management
Return Value: Word
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetXDataRefCount: Word;
begin
GetXDataRefCount := FDependentSeries.Count;
end;
{------------------------------------------------------------------------------
Function: TSeries.AssumeMasterSeries
Description: This function makes this series' X-Data the MASTER for the given list of dependent series.
Author: Mat Ballard
Date created: 08/25/2000
Date modified: 08/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AssumeMasterSeries(
XPts: Integer;
OldMaster: TSeries;
AList: TList): Boolean;
var
i: Integer;
begin
{There are many reasons why this might be a bad idea:}
if (OldMaster = nil) then raise
EComponentError.Create(Self.Name +
sAssumeMasterSeries1 + sAssumeMasterSeries2);
if (OldMaster <> FXDataSeries) then raise
EComponentError.Create(Self.Name +
sAssumeMasterSeries1 + FXDataSeries.Name +
sBecause + FXDataSeries.Name + sAssumeMasterSeries3);
if (XPts <> FNoPts) then raise
EComponentError.CreateFmt(Self.Name +
' (%d ' + sPoints + ')' + sAssumeMasterSeries4 + sWith + '%d ' + sPoints + ' !',
[FNoPts, XPts]);
{this last is probably redundant because of test #2:}
if (FDependentSeries.Count > 0) then raise
EComponentError.Create(Self.Name +
sAssumeMasterSeries4 + sBecause + sAssumeMasterSeries5);
for i := 0 to AList.Count-1 do
begin
if (AList.Items[i] <> Self) then
begin
{add these dependent series to our own list:}
FDependentSeries.Add(AList.Items[i]);
{tell them that this series is now the Master:}
TSeries(AList.Items[i]).ResetXDataSeries(OldMaster, Self);
end;
end;
{the X Data is now internal to this series:}
FExternalXSeries := FALSE;
FXDataSeries := nil;
{note that we already KNOW the location of the X Data: FXData !}
AssumeMasterSeries := TRUE;
end;
{------------------------------------------------------------------------------
Function: TSeries.ResetXDataSeries
Description: When a new series Assumes X Data Master status, it has to tell
all the dependent series
Author: Mat Ballard
Date created: 08/25/2000
Date modified: 08/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.ResetXDataSeries(OldSeries, NewSeries: TSeries): Boolean;
begin
if (FXDataSeries = OldSeries) then
begin
FXDataSeries := NewSeries;
ResetXDataSeries := TRUE;
end
else
ResetXDataSeries := FALSE;
end;
{------------------------------------------------------------------------------
Function: TSeries.PointToData
Description: uses data from an externally-managed array
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.PointToData(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Boolean;
begin
PointToData := FALSE;
if (DataStatus = dsNone) then
begin
DataStatus := dsExternal;
FXData := XPointer;
FYData := YPointer;
FNoPts := NumberOfPoints;
GetBounds; {which calls ResetBounds}
DoDataChange;
PointToData := TRUE;
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.AddDrawPoint
Description: adds a point then draws it
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management and screen display
Return Value: the number of data points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AddDrawPoint(X, Y: Single; ACanvas: TCanvas): Integer;
var
iX, iY: Integer;
TheResult: Integer;
begin
{Add the point; we don't fire any events, but we do adjust axes if required:
this may trigger a re-draw if Min/Max are exceeded:}
TheResult := AddPoint(X, Y, FALSE, TRUE);
AddDrawPoint := TheResult;
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.AddDrawPoint: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(TheResult < 0)) then exit;
{Draw from last to this point:}
ACanvas.Pen.Assign(FPen);
if (FNoPts > 1) then
begin
iX := FXAxis.FofX(FXData^[FNoPts-2])+ FDeltaX;
iY := FYAxis.FofY(FYData^[FNoPts-2]) + FDeltaY;
ACanvas.MoveTo(iX, iY);
iX := FXAxis.FofX(FXData^[FNoPts-1]) + FDeltaX;
iY := FYAxis.FofY(FYData^[FNoPts-1]) + FDeltaY;
ACanvas.LineTo(iX, iY);
end
else
begin
iX := FXAxis.FofX(FXData^[FNoPts-1]) + FDeltaX;
iY := FYAxis.FofY(FYData^[FNoPts-1]) + FDeltaY;
end;
if ((FSymbol <> syNone) and (FSymbolSize > 0)) then
begin
ACanvas.Brush.Assign(FBrush);
DrawSymbol(ACanvas, iX, iY);
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.AddPoint
Description: adds a data point, increasing memory if required
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: the number of data points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AddPoint(X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer;
begin
AddPoint := -1;
{$IFDEF DELPHI3_UP}
Assert(DataStatus <> dsExternal,
'TSeries.AddPoint: ' + sAddPointAssert1 + Name + ' ' + sSeries +
CRLF + sAddPointAssert2);
{$ENDIF}
if (DataStatus = dsNone) then
begin
DataStatus := dsInternal;
if (not IncMemSize) then exit; {will return false and exit if not enough memory}
ResetBounds;
end;
{Check memory available:}
if (FNoPts >= MemSize-2) then
if (not IncMemSize) then exit; {will return false and exit if not enough memory}
{If the X data is in another series, then we do not add it:}
if (FExternalXSeries) then
begin
{check validity of the External X data:}
if (FXDataSeries = nil) then raise
EAccessViolation.Create('TSeries.AddPoint: ' + sAddPoint1 + Name +
' ' + sSeries + sBecause + sAddPoint2);
if (FXDataSeries.NoPts <= FNoPts) then raise
ERangeError.CreateFmt('TSeries.AddPoint: ' + sAddPoint3,
[FXDataSeries.NoPts, FNoPts]);
if (FXDataSeries.XData = nil) then raise
EAccessViolation.Create('TSeries.AddPoint: ' + sAddPoint1 + Name +
' ' + sSeries + sBecause + sAddPoint4);
end
else
begin
{save the X data:}
FXData^[FNoPts] := X;
end;
{save the Y data:}
FYData^[FNoPts] := Y;
{Check the min and max X and Y properties of the series,
and adjust axes as required:}
CheckBounds(FNoPts, AdjustAxes);
if (FireEvent) then
DoDataChange;
Inc(FNoPts);
AddPoint := FNoPts;
end;
{------------------------------------------------------------------------------
Function: TSeries.AddStringPoint
Description: adds a data point with a String X value, increasing memory if required
Author: Mat Ballard
Date created: 11/16/2000
Date modified: 11/16/2000 by Mat Ballard
Purpose: data management
Return Value: the number of data points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.AddStringPoint(XString: String; X, Y: Single; FireEvent, AdjustAxes: Boolean): Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(DataStatus <> dsExternal,
'TSeries.AddStringPoint: ' + sAddPointAssert1 + Name + ' ' + sSeries +
CRLF + sAddPointAssert2);
{$ENDIF}
AddStringPoint := -1;
if (DataStatus = dsNone) then
begin
DataStatus := dsInternalString;
if (not IncMemSize) then exit; {will return false and exit if not enough memory}
ResetBounds;
end;
AddStringPoint := AddPoint(X, Y, FireEvent, AdjustAxes);
{If the X data is in another series, then we do not add it:}
if (not FExternalXSeries) then
begin
{save the X string data:}
FXStringData.Add(XString);
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.DelPoint
Description: deletes the point nearest to X and Y
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: the new number of points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.DelPoint(X, Y: Single; Confirm: Boolean): Integer;
{This deletes a single point, the closest one, from the xy data.}
var
i, ThePoint: Integer;
Distance, MinDistance: Single;
begin
DelPoint := -1;
if (FNoPts <= 0) then raise
ERangeError.CreateFmt('TSeries.DelPoint: ' + sDelPoint1, [FName]);
MinDistance := 3.4e38;
ThePoint := -1;
for i := 0 to FNoPts-1 do
begin
Distance := Abs(X - FXData^[i]) + Abs(Y - FYData^[i]);
if (MinDistance > Distance) then
begin
ThePoint := i;
end;
end;
if (ThePoint = -1) then
begin
exit;
end;
DelPoint := DelPointNumber(ThePoint, Confirm);
end;
{------------------------------------------------------------------------------
Function: TSeries.DelPointNumber
Description: deletes ThePoint by its index
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: the new number of points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.DelPointNumber(ThePoint: Integer; Confirm: Boolean): Integer;
{This deletes a single point, the Nth one, from the xy data.}
{}
{Note: this DOES NOT delete the X Value of externally-maintained X data
values, so it shifts the upper half of the series one point to the left.}
var
i: Integer;
TheMessage: String;
begin
DelPointNumber := -1;
if (FNoPts <= 0) then raise
ERangeError.CreateFmt('TSeries.DelPointNumber: ' + sDelPoint1,
[FName]);
if ((ThePoint < 0) or (ThePoint >= FNoPts)) then raise
ERangeError.CreateFmt('TSeries.DelPointNumber: ' + sDelPointNumber1,
[FName, FNoPts, ThePoint]);
if (FDependentSeries.Count > 0) then
begin
ERangeError.CreateFmt(
sDelPointNumber2,
[FDependentSeries.Count]);
exit;
end;
if (Confirm) then
begin
TheMessage := Format(sDelete + ' ' + sPoint +' %d: (%e.3, %e.3) ?',
[ThePoint, FXData^[ThePoint], FYData^[ThePoint]]);
if (mrNo = MessageDlg(
{$IFDEF LINUX}
sDelete + ' ' + sPoint,
{$ENDIF}
TheMessage,
mtWarning,
[mbYes, mbNo],
0)) then
exit;
end;
{we now use the slower method to be more consistent with the
dynamic array approach:}
if (not FExternalXSeries) then
begin
for i := ThePoint to FNoPts-2 do
begin
FXData^[i] := FXData^[i+1];
end;
if ((FXStringData <> nil) and
(FXStringData.Count > ThePoint)) then
FXStringData.Delete(ThePoint);
end;
for i := ThePoint to FNoPts-1 do
begin
FYData^[i] := FYData^[i+1];
end;
Dec(FNoPts);
DoDataChange;
DelPointNumber := FNoPts;
end;
{------------------------------------------------------------------------------
Function: TSeries.DelData
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: deletes an entire data set. It only works on internal data sets.
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.DelData: Boolean;
begin
DelData := FALSE;
if (DataStatus = dsNone) then exit;
if (FDependentSeries.Count > 0) then
begin
{Merde ! this series is being destroyed, but other series depend on it !
we therefore need to "pass the buck": pass the X Data that we've created, and
the list of dependent series to another series:}
TSeries(FDependentSeries.Items[0]).AssumeMasterSeries(FNoPts, Self, FDependentSeries);
{and now, the X Data is managed by an external series:}
FExternalXSeries := TRUE;
FDependentSeries.Clear;
end;
if (DataStatus = dsInternal) then
begin
if (not FExternalXSeries) then
begin
{$IFDEF DELPHI1}
FreeMem(FXData, MemSize * SizeOf(Single));
if (FXStringData <> nil) then
begin
FXStringData.Free;
FXStringData := nil;
FXAxis.SetLabelSeries(nil);
end;
end;
FreeMem(FYData, MemSize * SizeOf(Single));
{$ELSE}
ReAllocMem(FXData, 0);
if (FXStringData <> nil) then
begin
FXStringData.Free;
FXStringData := nil;
FXAxis.SetLabelSeries(nil);
end;
end;
ReAllocMem(FYData, 0);
{$ENDIF}
FXData := nil;
FYData := nil;
{FZData := nil;}
end;
FExternalXSeries := FALSE;
FNoPts := 0;
DataStatus := dsNone;
MemSize := 0;
ResetBounds;
DelData := TRUE;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.ClearHighsLows
Description: frees the Highs and Lows, and their Counts and Capacities
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Series analysis
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ClearHighsLows;
begin
if (FHighs <> nil) then
begin
FreeMem(FHighs, FHighCapacity * SizeOf(Integer));
FHighs := nil;
end;
if (FLows <> nil) then
begin
FreeMem(FLows, FHighCapacity * SizeOf(Integer));
FLows := nil;
end;
FHighLow := [];
FHighCapacity := 10;
FHighCount := 0;
FLowCount := 0;
end;
{------------------------------------------------------------------------------
Function: TSeries.Average
Description: calculates the average of a series over a range
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: numerical calculation
Return Value: the average: single
Known Issues:
------------------------------------------------------------------------------}
function TSeries.Average(TheLeft, TheRight: Single): Single;
var
i,
Start,
Finish,
Number: Integer;
Sum: Single;
begin
if (TheLeft > TheRight) then
begin
{swap TheLeft and TheRight}
Sum := TheLeft;
TheLeft := TheRight;
TheRight := Sum;
end;
{get the TheLeft and TheRight points:}
Start := GetNearestPointToX(TheLeft);
Finish := GetNearestPointToX(TheRight);
{adjust TheLeft and TheRight:}
if (FXData^[Start] < TheLeft) then
Inc(Start);
if (FXData^[Finish] > TheRight) then
Dec(Finish);
{initialize:}
Number := 0;
Sum := 0;
for i := Start to Finish do
begin
Sum := Sum + FYData^[i];
Inc(Number);
end;
Average := Sum / Number;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Linearize
Description: Linearizes (turns into a straight line) the data of a series over a range
Author: Mat Ballard
Date created: 05/30/2001
Date modified: 05/30/2001 by Mat Ballard
Purpose: numerical calculation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Linearize(TheLeft, TheRight: Single);
var
i,
Start,
Finish: Integer;
Slope, Intercept: Single;
begin
if (TheLeft > TheRight) then
begin
{swap TheLeft and TheRight}
Slope := TheLeft;
TheLeft := TheRight;
TheRight := Slope;
end;
{get the TheLeft and TheRight points:}
Start := GetNearestPointToX(TheLeft);
Finish := GetNearestPointToX(TheRight);
{adjust TheLeft and TheRight:}
if (FXData^[Start] < TheLeft) then
Inc(Start);
if (FXData^[Finish] > TheRight) then
Dec(Finish);
{initialize:}
Slope := (FYData^[Finish] - FYData^[Start]) /
(FXData^[Finish] - FXData^[Start]);
Intercept := FYData^[Finish] - Slope * FXData^[Finish];
for i := Start+1 to Finish-1 do
FYData^[i] := Slope * FXData^[i] + Intercept;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Zero
Description: zeros the data of a series over a range
Author: Mat Ballard
Date created: 05/30/2001
Date modified: 05/30/2001 by Mat Ballard
Purpose: numerical calculation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Zero(TheLeft, TheRight: Single);
var
i,
Start,
Finish: Integer;
TheTemp: Single;
begin
if (TheLeft > TheRight) then
begin
{swap TheLeft and TheRight}
TheTemp := TheLeft;
TheLeft := TheRight;
TheRight := TheTemp;
end;
{get the TheLeft and TheRight points:}
Start := GetNearestPointToX(TheLeft);
Finish := GetNearestPointToX(TheRight);
{adjust TheLeft and TheRight:}
if (FXData^[Start] < TheLeft) then
Inc(Start);
if (FXData^[Finish] > TheRight) then
Dec(Finish);
{initialize:}
for i := Start to Finish do
FYData^[i] := 0;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.MovingAverage
Description: Calculates the movong average
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Smoothing
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.MovingAverage(Span: Integer);
var
i, j,
Left, Right: Integer;
AverageData: pSingleArray;
begin
{allocate memory for arrays:}
GetMem(AverageData, FNoPts * SizeOf(Single));
for i := 0 to FNoPts-1 do
begin
AverageData^[i] := 0;
Left := i - Span;
Right := i + Span;
if (Left < 0) then
begin
Right := 2*i;
Left := 0;
end;
if (Right >= FNoPts) then
begin
Left := i - (FNoPts-1 - i);
Right := FNoPts-1;
end;
for j := Left to Right do
begin
AverageData^[i] := AverageData^[i] + FYData^[j];
end;
AverageData^[i] := AverageData^[i] / (1 + Right - Left);
end;
{NB: the following generates gross access violations:
System.Move(AverageData, FYData, FNoPts * SizeOf(Single));}
for i := 0 to FNoPts-1 do
FYData^[i] := AverageData^[i];
FreeMem(AverageData, FNoPts * SizeOf(Single));
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DoSpline
Description: Does the cubic spline of the data
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Places the cubic spline interpolation into X and Y
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DoSpline(Density: Integer; pSplineSeries: TSeries);
var
i,
j: Integer;
dX,
X: Single;
begin
{calculate the ...}
SecondDerivative;
{Index of the new spline points:}
for i := 0 to FNoPts-2 do
begin
pSplineSeries.AddPoint(FXData^[i], FYData^[i], FALSE, FALSE);
dX := (FXData^[i+1] - FXData^[i]) / (Density+1);
X := FXData^[i];
for j := 0 to Density-1 do
begin
X := X + dX;
pSplineSeries.AddPoint(X, SplineValue(X), FALSE, FALSE);
end;
end;
pSplineSeries.AddPoint(FXData^[FNoPts-1], FYData^[FNoPts-1], FALSE, FALSE);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SplineValue
Description: Calculates the Y co-ordinate from the cubic spline
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data manipulation
Known Issues: yet to be done
------------------------------------------------------------------------------}
function TSeries.SplineValue(X: Single): Single;
var
iLeft,
iRight,
i: integer;
dX,
LeftX,
RightX: Single;
begin
{in initialize left and right indices:}
iLeft := 0;
iRight := FNoPts-1;
{bracket the X value using binary search:}
while (iRight - iLeft > 1) do
begin
i := (iRight+iLeft) div 2;
if (FXData^[i] > X) then
iRight := i
else
iLeft := i;
end;
{width of bracketing interval is:}
dX := FXData^[iRight] - FXData^[iLeft];
{should we chuck a loopy ?}
if (dX = 0.0) then raise
ERangeError.CreateFmt('TSeries.SplineValue: ' + sSplineValue1 + ' (dX = 0) !' + CRLF+
'XData[%d] = %g, XData[%d] = %g', [iRight, FXData^[iRight], iLeft, FXData^[iLeft]]);
{the right and left portions are:}
RightX := (FXData^[iRight]-X) / dX;
LeftX := (X-FXData^[iLeft]) / dX;
{so the cubic spline estimate is:}
SplineValue := RightX * FYData^[iLeft] + LeftX * FYData^[iRight] +
((IntPower(RightX, 3) - RightX) * Fd2Y_dX2^[iLeft] +
(IntPower(LeftX, 3) - LeftX) * Fd2Y_dX2^[iRight]) *
Sqr(dX) / 6.0;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.SecondDerivative
Description: Does the cubic spline of the data
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Calculates the second derivatives for use by SplineValue
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.SecondDerivative;
var
i: integer;
TempVar,
LeftXFraction: Single;
UpperTriangle: pSingleArray;
begin
ClearSpline;
{allocate memory for the second derivatives:}
Size2ndDeriv := FNoPts * SizeOf(Single);
GetMem(Fd2Y_dX2, Size2ndDeriv);
GetMem(UpperTriangle, FNoPts * SizeOf(Single));
{handle the first point: we use "natural" boundary condition of
zero second derivative:}
Fd2Y_dX2^[0] := 0;
UpperTriangle^[0] := 0;
{do the loop over middle points:}
for i := 1 to FNoPts-2 do begin
LeftXFraction := (FXData^[i] - FXData^[i-1]) /
(FXData^[i+1] - FXData^[i-1]);
TempVar := LeftXFraction * Fd2Y_dX2^[i-1] + 2.0;
Fd2Y_dX2^[i] := (LeftXFraction - 1.0) / TempVar;
UpperTriangle^[i] := (FYData^[i+1] - FYData^[i]) / (FXData^[i+1] - FXData^[i]) -
(FYData^[i] - FYData^[i-1]) / (FXData^[i] - FXData^[i-1]);
UpperTriangle^[i] := (6.0 * UpperTriangle^[i] / (FXData^[i+1] - FXData^[i-1]) -
LeftXFraction * UpperTriangle^[i-1]) / TempVar;
end;
{handle the last point: we use "natural" boundary condition of
zero second derivative:}
Fd2Y_dX2^[FNoPts-1] := 0;
for i := FNoPts-2 downto 0 do
begin
Fd2Y_dX2^[i] := Fd2Y_dX2^[i] * Fd2Y_dX2^[i+1] + UpperTriangle^[i];
end;
FreeMem(UpperTriangle, FNoPts * SizeOf(Single));
end;
{------------------------------------------------------------------------------
Procedure: TSeries.ClearSpline
Description: frees the second derivative memory
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Spline memory management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ClearSpline;
begin
if (Fd2Y_dX2 <> nil) then
begin
FreeMem(Fd2Y_dX2, Size2ndDeriv);
Fd2Y_dX2 := nil;
Size2ndDeriv := 0;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Differentiate
Description: Replaces the Series Y data with its differential
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Data manipulation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Differentiate;
var
i: Integer;
Differential,
YOld: Single;
begin
{we save the first data point:}
YOld := FYData^[0];
{now do the first point by difference (1st order):}
FYData^[0] :=
(FYData^[1] - FYData^[0]) / (FXData^[1] - FXData^[0]);
for i := 1 to FNoPts-2 do
begin
{we calculate a mid-point (2nd order) differential}
Differential :=
(((FYData^[i] - YOld) / (FXData^[i] - FXData^[i-1])) +
((FYData^[i+1] - FYData^[i]) / (FXData^[i+1] - FXData^[i])))
/ 2;
YOld := FYData^[i];
FYData^[i] := Differential;
end;
{now do the last point by difference (1st order):}
FYData^[FNoPts-1] :=
(FYData^[FNoPts-1] - YOld) / (FXData^[FNoPts-1] - FXData^[FNoPts-2]);
{re-scale:}
FDeltaX := 0;
FDeltaY := 0;
ResetBounds;
GetBounds;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Integrate
Description: Replaces the Series Y data with its integral
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Data manipulation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Integrate;
var
i: Integer;
Sum,
YOld: Single;
begin
Sum := 0;
YOld := FYData^[0];
for i := 1 to FNoPts-1 do
begin
Sum := Sum +
(FYData^[i] + YOld) * (FXData^[i] - FXData^[i-1]) / 2;
YOld := FYData^[i];
FYData^[i] := Sum;
end;
{we set the first data point:}
FYData^[0] := 0;
{re-scale:}
FDeltaX := 0;
FDeltaY := 0;
ResetBounds;
GetBounds;
end;
{------------------------------------------------------------------------------
Function: TSeries.Integral
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the integral of the Series from Start to Finish
Return Value: the real area
Known Issues: see IntegralByPoint below
------------------------------------------------------------------------------}
function TSeries.Integral(TheLeft, TheRight: Single): Single;
var
Start,
Finish: Integer;
Sum,
YEst: Single;
begin
if (TheLeft > TheRight) then
begin
{swap TheLeft and TheRight}
Sum := TheLeft;
TheLeft := TheRight;
TheRight := Sum;
end;
{get the TheLeft and TheRight points:}
Start := GetNearestPointToX(TheLeft);
Finish := GetNearestPointToX(TheRight);
{adjust TheLeft and TheRight:}
if (FXData^[Start] < TheLeft) then
Inc(Start);
if (FXData^[Finish] > TheRight) then
Dec(Finish);
{Integrate the bulk:}
Sum := IntegralByPoint(Start, Finish);
{Add the end bits:}
if ((Start > 0) and
(FXData^[Start] <> TheLeft)) then
begin
YEst := FYData^[Start-1] +
(FYData^[Start] - FYData^[Start-1]) *
(TheLeft - FXData^[Start-1]) / (FXData^[Start] - FXData^[Start-1]);
Sum := Sum +
(FXData^[Start] - TheLeft) *
(FYData^[Start] + YEst) / 2;
end;
if ((Finish < FNoPts-1) and
(FXData^[Finish] <> TheRight)) then
begin
YEst := FYData^[Finish] +
(FYData^[Finish+1] - FYData^[Finish]) *
(TheRight - FXData^[Finish]) / (FXData^[Finish+1] - FXData^[Finish]);
Sum := Sum +
(TheRight - FXData^[Finish]) *
(FYData^[Finish] + YEst) / 2;
end;
Integral := Sum;
end;
{------------------------------------------------------------------------------
Function: TSeries.IntegralByPoint
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the integral of the Series from iStart to iFinish
Return Value: the real area
Known Issues: see Integral above
------------------------------------------------------------------------------}
function TSeries.IntegralByPoint(Start, Finish: Integer): Single;
var
i: Integer;
Sum: Single;
begin
if (Start > Finish) then
begin
{swap Start and Finish}
i := Start;
Start := Finish;
Finish := i;
end;
Sum := 0;
for i := Start+1 to Finish do
begin
Sum := Sum +
(FYData^[i] + FYData^[i-1]) * (FXData^[i] - FXData^[i-1]) / 2;
end;
{we set the first data point:}
IntegralByPoint := Sum;
end;
{------------------------------------------------------------------------------
Function: TSeries.IncMemSize
Description: increases the available memory for data
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data and memory management
Return Value: TRUE if successful
Known Issues:
------------------------------------------------------------------------------}
function TSeries.IncMemSize: Boolean;
begin
IncMemSize := AllocateNoPts(MemSize + FDefSize);
if ((DataStatus = dsInternalString) and (FXStringData = nil)) then
begin
FXStringData := TStringList.Create;
FXAxis.SetLabelSeries(Self);
end;
end;
{------------------------------------------------------------------------------
Function: TSeries.InsertPoint
Description: inserts a data point
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the ??? Property
Return Value: new number of data points
Known Issues:
------------------------------------------------------------------------------}
function TSeries.InsertPoint(X, Y: Single): Integer;
var
i, ThePoint: Integer;
begin
InsertPoint := -1;
if ((DataStatus = dsNone) or (FNoPts = 0))then
begin
{we add the point, firing events and adjusting axes as neccessary:}
InsertPoint := AddPoint(X, Y, TRUE, TRUE);
exit;
end;
{Find out where to insert this point:}
ThePoint := 0;
{TheXPointer := FXData;}
for i := 0 to FNoPts-1 do
begin
if (FXData^[i] > X) then
begin
ThePoint := i;
end
else if (ThePoint > 0) then
begin
break;
end;
{Inc(TheXPointer);}
end;
if (ThePoint = FNoPts-1) then
begin
{we add the point, firing events and adjusting axes as neccessary:}
InsertPoint := AddPoint(X, Y, TRUE, TRUE);
exit;
end;
{Check memory available:}
if (FNoPts >= MemSize-2) then
if (not IncMemSize) then exit; {will return false and exit if not enough memory}
if (not FExternalXSeries) then
begin
for i := FNoPts downto ThePoint+1 do
begin
FXData^[i] := FXData^[i-1];
end;
FXData^[ThePoint] := X;
end;
for i := FNoPts downto ThePoint+1 do
begin
FYData^[i] := FYData^[i-1];
end;
FYData^[ThePoint] := Y;
Inc(FNoPts);
DoDataChange;
InsertPoint := FNoPts;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Smooth
Description: smoothes the data using a modified Savitsky-Golay method
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data manipulation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Smooth(SmoothOrder: Integer);
var
i, j, K: Integer;
Start, Finish: Integer;
IntSum: Integer;
Sum, SumStart, SumFinish: Single;
pSmoothData: pSingleArray;
SCMatrix, pSCMatrix: pInteger; {Longword ?}
{define pSCMatrix(i, j) == pSCMatrix(i + (FNoPts+1) * j)}
pSCSum: pIntegerArray; {Longword ?}
{Msg: String;}
{NOTE: Multidimensional dynamic arrays DON'T WORK !}
procedure SetSCMatrixPointer(i, j: Integer);
begin
if (SmoothOrder < 2) then raise
ERangeError.CreateFmt('SetSCMatrixPointer: SCMatrix(%d, %d) ' + sSetSCMatrixPointer1,
[i, j]);
pSCMatrix := SCMatrix;
Inc(pSCMatrix, i + (SmoothOrder+1) * j);
end;
{procedure DisplayMatrix;
var
ii, jj: Integer;
DMsg: String;
begin
//display the matrix:
DMsg := Format('Smooth Order = %d, Start = %d, Finish = %d',
[SmoothOrder, Start, Finish]) + CRLF;
DMsg := DMsg + CRLF + 'The smoothing Matrix is:';
For ii := 0 To SmoothOrder do
begin
DMsg := DMsg + CRLF;
For jj := 0 To SmoothOrder do
begin
SetSCMatrixPointer(ii, jj);
DMsg := DMsg + IntToStr(pSCMatrix^) + ', '
end;
end;
DMsg := DMsg + CRLF + CRLF+ 'The smoothing Sums are:' + #13+#10;
pSCSum := SCSum;
For ii := 0 To SmoothOrder do
begin
DMsg := DMsg + IntToStr(pSCSum^) + ', ';
Inc(pSCSum);
end;
ShowMessage(DMsg);
end;}
begin
if ((SmoothOrder < 2) or (SmoothOrder > 20)) then raise
ERangeError.CreateFmt('TSeries.Smooth: ' + sSmooth1,
[SmoothOrder]);
if (FNoPts <= SmoothOrder+1) then raise
ERangeError.CreateFmt('TSeries.Smooth: ' + sSmooth2,
[SmoothOrder, FNoPts]);
{allocate memory for arrays:}
GetMem(pSmoothData, FNoPts * SizeOf(Single));
GetMem(SCMatrix, (SmoothOrder+1) * (SmoothOrder+1) * SizeOf(Integer));
GetMem(pSCSum, (SmoothOrder+1) * SizeOf(Integer));
{Zero the matrix:}
For i := 0 To SmoothOrder do {i <=> Rows}
begin
For j := 0 to SmoothOrder do {j <=> Column}
begin
SetSCMatrixPointer(i, j);
pSCMatrix^ := 0;
end;
end;
{set the first column and the diagonals to 1:}
For i := 0 To SmoothOrder do
begin
SetSCMatrixPointer(i, 0);
pSCMatrix^ := 1;
SetSCMatrixPointer(i, i);
pSCMatrix^ := 1;
end;
{Calculate the Smoothing Coefficients:
now columns 1, 2, ... SmoothOrder:}
For i := 2 To SmoothOrder do {i <=> Rows}
begin
For j := 1 to i-1 do {j <=> Column}
begin
SetSCMatrixPointer(i - 1, j - 1);
IntSum := pSCMatrix^;
SetSCMatrixPointer(i - 1, j);
IntSum := IntSum + pSCMatrix^;
SetSCMatrixPointer(i, j);
pSCMatrix^ := IntSum;
end;
end;
{ For j% = 1 To SmoothOrder%
For i% = j% To SmoothOrder%
Sum! = 0
For K% = 0 To i% - 1
Sum! = Sum! + SC(K%, j% - 1)
Next K%
SC(i%, j%) = Sum!
Next i%
Next j%}
{Calculate the sums:}
For i := 0 To SmoothOrder do {i <=> Rows}
begin
pSCSum^[i] := 0;
For j := 0 To i do {j <=> Columns}
begin
SetSCMatrixPointer(i, j);
pSCSum^[i] := pSCSum^[i] + pSCMatrix^;
end;
end;
{ For i% = 0 To SmoothOrder%
SCSum(i%) = 0
For j% = 0 To i%
SCSum(i%) = SCSum(i%) + SC(i%, j%)
Next j%
Next i%}
{Calculate the starting and ending points:}
Start := SmoothOrder div 2;
Finish := FNoPts - Start;
{ Start% = Int(SmoothOrder% / 2)
Finish% = Runs.No_Pts - Start%}
{DisplayMatrix;}
{these first and last points don't change:}
pSmoothData^[0] := FYData^[0];
pSmoothData^[FNoPts-1] := FYData^[FNoPts-1];
{ Smooth_Data(0) = Y_Data(0)
Smooth_Data(Runs.No_Pts) = Y_Data(Runs.No_Pts)}
{Do the messy points in between:}
For K := 1 To (SmoothOrder - 2) div 2 do
{ For i% = 2 To (SmoothOrder% - 2) Step 2}
begin
i := 2*K;
SumStart := 0;
SumFinish := 0;
For j := 0 To i do
begin
SetSCMatrixPointer(i, j);
SumStart := SumStart + FYData^[j] * pSCMatrix^;
{ SumStart& = SumStart& + CLng(Y_Data(j%)) * CLng(SC(i%, j%))}
SumFinish := SumFinish + FYData^[FNoPts-1-j] * pSCMatrix^;
{ SumFinish& = SumFinish& + CLng(Y_Data(Runs.No_Pts - j%)) * CLng(SC(i%, j%))}
end;
pSmoothData^[K] := SumStart / pSCSum^[i];
{ Smooth_Data(i% / 2) = SumStart& / SCSum(i%)}
pSmoothData^[FNoPts-1-K] := SumFinish / pSCSum^[i];
{ Smooth_Data(Runs.No_Pts - i% / 2) = SumFinish& / SCSum(i%)}
end;
{ For i% = 2 To (SmoothOrder% - 2) Step 2
SumStart& = 0
SumFinish& = 0
For j% = 0 To i%
SumStart& = SumStart& + CLng(Y_Data(j%)) * CLng(SC(i%, j%))
SumFinish& = SumFinish& + CLng(Y_Data(Runs.No_Pts - j%)) * CLng(SC(i%, j%))
Next j%
Smooth_Data(i% / 2) = SumStart& / SCSum(i%)
Smooth_Data(Runs.No_Pts - i% / 2) = SumFinish& / SCSum(i%)
Next i%}
{loop over the fully-smoothed points:}
For K := Start To Finish-1 do
begin
Sum := 0;
For j := 0 To SmoothOrder do
begin
SetSCMatrixPointer(SmoothOrder, j);
Sum := Sum + FYData^[K+j-Start] * pSCMatrix^;
{ Sum! = Sum! + Y_Data(K% + j% - Start%) * CSng(SC(SmoothOrder%, j%))}
end;
pSmoothData^[K] := Sum / pSCSum^[SmoothOrder];
{ Smooth_Data(K%) = Sum! / SCSum(SmoothOrder%)}
end;
{finally, update the Y data:}
For i := 0 To FNoPts-1 do
FYData^[i] := pSmoothData^[i];
{NB: this causes terminal access violations:
System.Move(pSmoothData, FYData, FNoPts * SizeOf(Single));}
{$IFDEF DELPHI1}
FreeMem(pSmoothData, FNoPts * SizeOf(Single));
FreeMem(SCMatrix, (SmoothOrder+1) * (SmoothOrder+1) * SizeOf(Integer));
FreeMem(pSCSum, (SmoothOrder+1) * SizeOf(Integer));
{$ELSE}
FreeMem(pSmoothData);
FreeMem(SCMatrix);
FreeMem(pSCSum);
{$ENDIF}
DoDataChange;
end;
{Sub Smooth (SmoothOrder%, X_Data() As Single, Y_Data() As Single)
' This function smooths the data using a midpoint method
' Keywords:
' smooth
' Input:
'
' Modifies:
' nothing
' Output:
' none
' Returns:
'
' Called From:
'
' Calls:
'
Dim i%, j%, K%
Dim Start%, Finish%
Dim SumStart&, SumFinish&
Dim Sum!
Dim Msg$
ReDim Smooth_Data(0 To Runs.Array_Size) As Single
On Error GoTo Smooth_ErrorHandler
' declare the matrix of coefficients for smoothing:
ReDim SC(0 To SmoothOrder%, 0 To SmoothOrder%) As Long
ReDim SCSum(0 To SmoothOrder%) As Long
' set the first column to 1:
For i% = 0 To SmoothOrder%
SC(i%, 0) = 1
Next i%
' Calculate the Smoothing Coefficients:
' now columns 1, 2, ... SmoothOrder%:
For j% = 1 To SmoothOrder%
For i% = j% To SmoothOrder%
Sum! = 0
For K% = 0 To i% - 1
Sum! = Sum! + SC(K%, j% - 1)
Next K%
SC(i%, j%) = Sum!
Next i%
Next j%
' Calculate the sums:
For i% = 0 To SmoothOrder%
SCSum(i%) = 0
For j% = 0 To i%
SCSum(i%) = SCSum(i%) + SC(i%, j%)
Next j%
Next i%
' Msg$ = "Smoothing Matrix:"
' For i% = 0 To SmoothOrder%
' Msg$ = Msg$ & LF
' For j% = 0 To SmoothOrder%
' Msg$ = Msg$ & Str$(SC(i%, j%)) & ", "
' Next j%
' Next i%
' Msg$ = Msg$ & LF & LF & "Smoothing Sums:"
' For i% = 0 To SmoothOrder%
' Msg$ = Msg$ & Str$(SCSum(i%)) & ", "
' Next i%
' MsgBox Msg$, MB_OK, "Smoothing"
' Calculate the starting and ending points:
Start% = Int(SmoothOrder% / 2)
Finish% = Runs.No_Pts - Start%
' Do the smooth; end points are not affected:
Smooth_Data(0) = Y_Data(0)
Smooth_Data(Runs.No_Pts) = Y_Data(Runs.No_Pts)
' Do the messy points in between:
For i% = 2 To (SmoothOrder% - 2) Step 2
SumStart& = 0
SumFinish& = 0
For j% = 0 To i%
SumStart& = SumStart& + CLng(Y_Data(j%)) * CLng(SC(i%, j%))
SumFinish& = SumFinish& + CLng(Y_Data(Runs.No_Pts - j%)) * CLng(SC(i%, j%))
Next j%
Smooth_Data(i% / 2) = SumStart& / SCSum(i%)
Smooth_Data(Runs.No_Pts - i% / 2) = SumFinish& / SCSum(i%)
Next i%
' loop over the fully-smoothed points:
For K% = Start% To Finish%
Sum! = 0
For j% = 0 To SmoothOrder%
Sum! = Sum! + Y_Data(K% + j% - Start%) * CSng(SC(SmoothOrder%, j%))
Next j%
Smooth_Data(K%) = Sum! / SCSum(SmoothOrder%)
Next K%
' finally, update the RI data:
For i% = 0 To Runs.No_Pts
Y_Data(i%) = Smooth_Data(i%)
Next i%
Smooth_FINISHED:
Refresh
Exit Sub
Smooth_ErrorHandler: ' Error handler line label.
Msg$ = "Panic in " & "Smooth_ErrorHandler !"
Msg$ = Msg$ & LF & LF & "Error No. " & Str$(Err) & ": " & Error$
Response% = Message(Msg$, MB_OK + MB_ICONEXCLAMATION, "Error !", NO, H_PANIC)
Resume Smooth_FINISHED
End Sub
}
{------------------------------------------------------------------------------
Procedure: TSeries.Sort
Description: Sorts the data using the HeapSort method
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Data manipulation
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Sort;
{$IFDEF DELPHI1}
begin
ShowMessage('Sorting is not supported under Delphi 1.');
end;
{$ELSE}
var
i: Integer;
pMem: Pointer;
pPoint: pXYPoint;
TheList: TList;
begin
{create and initialize the list of points:}
TheList := TList.Create;
TheList.Capacity := FNoPts;
{allocate one big block of memory:}
GetMem(pMem, FNoPts * SizeOf(TXYPoint));
{point at the beginning:}
pPoint := pMem;
{loop over all points:}
for i := 0 to FNoPts-1 do
begin
pPoint^.X := FXData^[i];
pPoint^.Y := FYData^[i];
TheList.Add(pPoint);
Inc(pPoint);
end;
{do the dirty deed:}
TheList.Sort(Compare);
{point at the beginning:}
pPoint := pMem;
{loop over all points to save results:}
for i := 0 to FNoPts-1 do
begin
FXData^[i] := pPoint^.X;
FYData^[i] := pPoint^.Y;
Inc(pPoint);
end;
TheList.Free;
FreeMem(pMem, FNoPts * SizeOf(TXYPoint));
end;
{$ENDIF}
{------------------------------------------------------------------------------
Function: Compare
Description: comparison function for sorting
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: compares the X ordinate of point for a TList quicksort
Return Value: -1, 0 or 1
Known Issues:
------------------------------------------------------------------------------}
function Compare(Item1, Item2: Pointer): Integer;
begin
if (pXYPoint(Item1)^.X < pXYPoint(Item2)^.X) then
begin
Compare := -1;
end
else if (pXYPoint(Item1)^.X = pXYPoint(Item2)^.X) then
begin
Compare := 0;
end
else
begin
Compare := 1;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.GetPoint
Description: returns the Nth (0..NoPts-1) point's X and Y values.
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.GetPoint(N: Integer; var X, Y: Single);
begin
if ((N < 0) or (N >= FNoPts)) then raise
ERangeError.CreateFmt('TSeries.GetPoint: ' + sGetPoint1,
[N, FNoPts]);
X := FXData^[N];
Y := FYData^[N];
end;
{------------------------------------------------------------------------------
Function: TSeries.GetXYPoint
Description: returns the Nth (0..NoPts-1) point's X and Y values.
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: XY
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetXYPoint(N: Integer): TXYPoint;
{This returns the Nth (0..NoPts-1) point's X and Y values.}
var
XY: TXYPoint;
begin
if ((N < 0) or (N >= FNoPts)) then raise
ERangeError.CreateFmt('TSeries.GetXYPoint: ' + sGetPoint1,
[N, FNoPts]);
XY.X := FXData^[N];
XY.Y := FYData^[N];
GetXYPoint := XY;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Displace
Description: Runs the "Displace" dialog box
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: user management of Series displacement
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Displace(TheHelpFile: String);
var
DisplacementForm: TDisplacementForm;
begin
DisplacementForm := TDisplacementForm.Create(nil);
DisplacementForm.TheSeries := TObject(Self);
DisplacementForm.SeriesLabel.Caption := FName;
DisplacementForm.DeltaXNEdit.AsInteger := FDeltaX;
DisplacementForm.DeltaYNEdit.AsInteger := FDeltaY;
DisplacementForm.HelpFile := TheHelpFile;
if (DisplacementForm.ShowModal = mrOK) then
ApplyDisplacementChange(DisplacementForm);
DisplacementForm.Free;
end;
{------------------------------------------------------------------------------
Procedure: TCustomPlot.ApplyDisplacementChange
Description: This applies changes from the Displace Dialog.
Author: Mat Ballard
Date created: 03/28/2001
Date modified: 03/28/2001 by Mat Ballard
Purpose: User interface management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ApplyDisplacementChange(Sender: TObject);
begin
with TDisplacementForm(Sender) do
begin
FDeltaX := DeltaXNEdit.AsInteger;
FDeltaY := DeltaYNEdit.AsInteger;
end;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TCustomPlot.EditData
Description: Runs the Data Editor for the selected Series
Author: Mat Ballard
Date created: 03/13/2001
Date modified: 03/13/2001 by Mat Ballard
Purpose:
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.EditData(TheHelpFile: String);
var
i: Integer;
DataEditor: TDataEditorForm;
begin
if (FNoPts > 1024) then
begin
ShowMessageFmt(sTooManyToEdit, [FNoPts]);
exit;
end;
DataEditor := TDataEditorForm.Create(nil);
DataEditor.HelpFile := TheHelpFile;
DataEditor.ExternalXSeries := FExternalXSeries or (DataStatus = dsExternal);
DataEditor.DependentXSeries := (FDependentSeries.Count > 0);
DataEditor.TheSeries := TObject(Self);
DataEditor.ExternalXSeries := Self.FExternalXSeries;
DataEditor.SeriesnameLabel.Caption := Self.Name;
{StatusBar1.SimpleText := Format('%d points', [FNoPts]);}
DataEditor.ZDataNEdit.AsReal := ZData;
DataEditor.DataStringGrid.RowCount := FNoPts + 1;
for i := 0 to FNoPts - 1 do
begin
DataEditor.DataStringGrid.Cells[0, i+1] := IntToStr(i);
DataEditor.DataStringGrid.Cells[1, i+1] := FloatToStr(FXData^[i]);
DataEditor.DataStringGrid.Cells[2, i+1] := FloatToStr(FYData^[i]);
end;
if (XStringData <> nil) then
begin
for i := 0 to XStringData.Count-1 do
DataEditor.DataStringGrid.Cells[3, i+1] := XStringData.Strings[i];
end;
if (DataEditor.ShowModal = mrOK) then
ApplyDataChange(DataEditor);
DataEditor.Free;
end;
{------------------------------------------------------------------------------
Procedure: TCustomPlot.ApplyDataChange
Description: This applies changes from the DataDialog.
Author: Mat Ballard
Date created: 03/28/2001
Date modified: 03/28/2001 by Mat Ballard
Purpose: User interface management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ApplyDataChange(Sender: TObject);
var
i,
TotalLength: Integer;
StringData: TStringList;
begin
with TDataEditorForm(Sender) do
begin
if (RowCountChanged) then
begin
if (DataStringGrid.RowCount >= MemSize) then
IncMemSize;
NumericDataChanged := TRUE;
StringDataChanged := TRUE;
FNoPts := DataStringGrid.RowCount-1;
end;
if (NumericDataChanged) then
begin
for i := 1 to DataStringGrid.RowCount - 1 do
begin
FXData^[i-1] := StrToFloat(DataStringGrid.Cells[1, i]);
FYData^[i-1] := StrToFloat(DataStringGrid.Cells[2, i]);
end;
end;
if (StringDataChanged) then
begin
StringData := TStringList.Create;
StringData.Assign(DataStringGrid.Cols[3]);
StringData.Delete(0);
TotalLength := 0;
for i := 0 to StringData.Count-1 do
TotalLength := TotalLength + Length(StringData[i]);
if (TotalLength > 0) then
{This assignment isn't what you think it is:
exercise: trace into it:}
XStringData := StringData;
StringData.Free;
end;
{Find out the new X and Y Min and Max values:}
ResetBounds;
GetBounds;
end;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.EditPoint
Description: Runs the "EditPoint" dialog box
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: user management of Series displacement
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.EditPoint(ThePointNumber: Integer; TheHelpFile: String);
var
PointEditorForm: TPointEditorForm;
TheResult: TModalResult;
begin
PointEditorForm := TPointEditorForm.Create(nil);
PointEditorForm.TheSeries := Self;
PointEditorForm.Init(FXData, FYData, FXStringData, FXAxis, FYAxis);
PointEditorForm.PointSlideBar.Max := FNoPts-1;
PointEditorForm.PointSlideBar.Frequency := Round(FNoPts/10);
PointEditorForm.PointSlideBar.PageSize := PointEditorForm.PointSlideBar.Frequency;
{$IFDEF BCB}
PointEditorForm.PointUpDown.Max := FNoPts-1;
PointEditorForm.PointNEdit.Max := FNoPts-1;
{$ELSE}
{$IFDEF MSWINDOWS}
PointEditorForm.PointSpinEdit.MaxValue := FNoPts-1;
{$ENDIF}
{$IFDEF LINUX}
PointEditorForm.PointSpinEdit.Max := FNoPts-1;
{$ENDIF}
{$ENDIF}
PointEditorForm.PointSlideBar.Position := ThePointNumber;
PointEditorForm.FillData(ThePointNumber);
PointEditorForm.DetailsLabel.Caption := FName;
if (FExternalXSeries) then
begin
PointEditorForm.XDataNEdit.Enabled := FALSE;
PointEditorForm.XScreenNEdit.Enabled := FALSE;
end;
PointEditorForm.HelpFile := TheHelpFile;
TheResult := PointEditorForm.ShowModal;
ApplyPointChange(PointEditorForm, TheResult);
PointEditorForm.Free;
end;
{------------------------------------------------------------------------------
Procedure: TCustomPlot.ApplyPointChange
Description: This applies changes from the PointEditor Dialog.
Author: Mat Ballard
Date created: 03/28/2001
Date modified: 03/28/2001 by Mat Ballard
Purpose: User interface management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ApplyPointChange(Sender: TObject; TheResult: TModalResult);
var
ThePointNumber: Integer;
XNew, YNew: Single;
begin
with TPointEditorForm(Sender) do
begin
if (TheResult <> mrCancel) then
begin
ThePointNumber := PointSlideBar.Position;
if (DataGroupBox.Enabled) then
begin
XNew := XDataNEdit.AsReal;
YNew := YDataNEdit.AsReal;
end
else
begin {base on screen co-ords:}
XNew := FXAxis.XofF(XScreenNEdit.AsInteger);
YNew := FYAxis.YofF(YScreenNEdit.AsInteger);
end;
case TheResult of
mrOK:
begin
ReplacePoint(ThePointNumber, XNew, YNew);
if ((FXStringData <> nil) and
(FXStringData.Count > ThePointNumber)) then
FXStringData.Strings[ThePointNumber] := XStringDataEdit.Text;
CheckBounds(ThePointNumber, TRUE);
end;
mrYes:
begin
if (FXStringData <> nil) then
AddStringPoint(XStringDataEdit.Text, XNew, YNew, TRUE, TRUE)
else
AddPoint(XNew, YNew, TRUE, TRUE);
CheckBounds(FNoPts, TRUE);
end;
mrNo:
DelPointNumber(ThePointNumber, TRUE);
end;
end; {if}
end;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.ReplacePoint
Description: Replaces the Nth point with new values
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ReplacePoint(N: Integer; NewX, NewY: Single);
begin
if (DataStatus <> dsInternal) then exit;
if ((N < 0) or (N >= FNoPts)) then raise
ERangeError.CreateFmt('TSeries.ReplacePoint: ' + sGetPoint1,
[N, FNoPts]);
if (not FExternalXSeries) then
FXData^[N] := NewX;
FYData^[N] := NewY;
DoDataChange;
end;
{Odds and sods --------------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TSeries.Compress
Description: reduces the size of the data set by local averaging
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 10/15/2000 by Mat Ballard
Purpose: data manipulation and management
Known Issues: Tidied up: Contract originally compressed; now it really does contract.
------------------------------------------------------------------------------}
procedure TSeries.Compress(CompressRatio: Integer);
var
i, j, k: Integer;
XSum, YSum: Single;
begin
if ((CompressRatio < 2) or (FNoPts div CompressRatio < 10 )) then
begin
{we used to throw an exception here, but this roots CompressAllSeries}
ShowMessage(Format('TSeries.Compress: ' + sCompressData1,
[FName, FNoPts, CompressRatio]));
exit;
end;
j := 0;
k := 0;
XSum := 0;
YSum := 0;
for i := 0 to FNoPts-1 do
begin
XSum := XSum + FXData^[i];
YSum := YSum + FYData^[i];
Inc(j);
if (j = CompressRatio) then
begin
if (not FExternalXSeries) then
FXData^[k] := XSum / j;
FYData^[k] := YSum / j;
j := 0;
XSum := 0;
YSum := 0;
Inc(k);
end;
end; {for}
if (j > 0) then
begin
if (not FExternalXSeries) then
FXData^[k] := XSum / j;
FYData^[k] := YSum / j;
Inc(k);
end;
FNoPts := k;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Contract
Description: reduces the size of the data set by throwing away the ends of the data set
Author: Mat Ballard
Date created: 10/15/2000
Date modified: 10/15/2000 by Mat Ballard
Purpose: data manipulation and management
Known Issues: Tidied up: Contract originally compressed; now it really does contract.
------------------------------------------------------------------------------}
procedure TSeries.Contract(TheStart, TheFinish: Integer);
var
i: Integer;
begin
if (TheStart > TheFinish) then
begin
i := TheStart;
TheStart := TheFinish;
TheFinish := i;
end;
if ((TheStart < 0) or (TheFinish > FNoPts)) then
begin
{we used to throw an exception here, but this roots ContractAllSeries}
ShowMessage(Format('TSeries.Contract: ' + sContractData1,
[FName, TheStart, TheFinish]));
exit;
end;
if (TheStart > 0) then
begin
for i := TheStart to TheFinish do
FYData^[i-TheStart] := FYData^[i];
if (not FExternalXSeries) then
for i := TheStart to TheFinish do
FXData^[i-TheStart] := FXData^[i];
end;
FNoPts := TheFinish - TheStart +1;
Self.ResetBounds;
Self.GetBounds;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.CopyToClipBoard
Description: Copies this Series to the clipboard as tab-delimited text
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: moving data in and out of the application
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.CopyToClipBoard;
var
{Q: which is more efficient: a String or a TStringList ?}
TheData: String;
i: Integer;
begin
TheData := FName;
TheData := TheData + CRLF + FXAxis.Title.Caption + #9 + FYAxis.Title.Caption;
TheData := TheData + CRLF + FXAxis.Title.Units + #9 + FYAxis.Title.Units;
for i := 0 to FNoPts-1 do
begin
TheData := TheData + CRLF + FloatToStr(FXData^[i]) + #9 + FloatToStr(FYData^[i]);
end;
Clipboard.AsText := TheData;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.CheckBounds
Description: Checks if ThePointNo exceeds the Series Mins and Maxes
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: many: data and screen management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.CheckBounds(ThePointNo: Integer; AdjustAxis: Boolean);
begin
if (FXMin > FXData^[ThePointNo]) then
begin
FXMin := FXData^[ThePointNo];
if (AdjustAxis) then
FXAxis.SetMinFromSeries(FXMin);
{if (assigned(FOnXMinChange) and FVisible) then OnXMinChange(Self, FXMin);}
end;
if (FXMax < FXData^[ThePointNo]) then
begin
FXMax := FXData^[ThePointNo];
if (AdjustAxis) then
FXAxis.SetMaxFromSeries(FXMax);
{if (assigned(FOnXMaxChange) and FVisible) then OnXMaxChange(Self, FXMax);}
end;
if (FYMin > FYData^[ThePointNo]) then
begin
FYMin := FYData^[ThePointNo];
if (AdjustAxis) then
FYAxis.SetMinFromSeries(FYMin);
{if (assigned(FOnYMinChange) and FVisible) then OnYMinChange(Self, FYMin);}
end;
if (FYMax < FYData^[ThePointNo]) then
begin
FYMax := FYData^[ThePointNo];
if (AdjustAxis) then
FYAxis.SetMaxFromSeries(FYMax);
{if (assigned(FOnYMaxChange) and FVisible) then OnYMaxChange(Self, YMax);}
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.GetBounds
Description: Determines the Mins and Maxes of this Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: sets the XMin, XMax, YMin and YMax Properties
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.GetBounds;
var
i: Integer;
begin
for i := 0 to FNoPts-1 do
begin
if (FXMin > FXData^[i]) then FXMin := FXData^[i];
if (FXMax < FXData^[i]) then FXMax := FXData^[i];
if (FYMin > FYData^[i]) then FYMin := FYData^[i];
if (FYMax < FYData^[i]) then FYMax := FYData^[i];
end;
FXAxis.SetMinMaxFromSeries(FXMin, FXMax);
FYAxis.SetMinMaxFromSeries(FYMin, FYMax);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.ResetBounds
Description: Resets the Mins and Maxes
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.ResetBounds;
begin
FXMin := 3.4e38;
FXMax := -3.4e38;
FYMin := 3.4e38;
FYMax := -3.4e38;
end;
{------------------------------------------------------------------------------
Function: TSeries.GetNearestPointToFX
Description: does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: Index of nearest point
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetNearestPointToFX(FX: Integer): Integer;
{This uses a binary search method to find the point with an X value closest to X.}
begin
GetNearestPointToFX :=
GetNearestPointToX(Self.FXAxis.XofF(FX));
end;
{------------------------------------------------------------------------------
Function: TSeries.GetNearestPointToX
Description: does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: Index of nearest point
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetNearestPointToX(X: Single): Integer;
{This uses a binary search method to find the point with an X value closest to X.}
var
iEst, iLow, iHigh: Integer;
begin
{Is X outside the range of X Values ?}
if (X >= FXMax) then
begin
GetNearestPointToX := FNoPts-1;
exit;
end;
if (X <= FXMin) then
begin
GetNearestPointToX := 0;
exit;
end;
{The lowest and highest possible points are:}
iLow := 0;
iHigh := FNoPts - 1;
{Estimate a starting point:}
iEst := Round(FNoPts * (X-FXMin)/(FXMax - FXMin));
repeat
if (X < FXData^[iEst]) then
begin
{The point is lower:}
iHigh := iEst;
iEst := (iEst + iLow) div 2;
end
else
begin
{The point is higher:}
iLow := iEst;
iEst := (iEst + iHigh) div 2;
end;
until ((iEst-iLow) <= 1) and ((iHigh-iEst) <= 1);
{find the X values just below and just above:}
if ((X < FXData^[iLow]) or (X > FXData^[iHigh])) then
begin
raise EComponentError.CreateFmt(sGetNearestPointToX1
+ CRLF + 'X ' + sGetNearestPointToX2 + ' = %g/%g/%g',
[X, FXData^[iLow], FXData^[iEst], FXData^[iHigh]]);
end
else if (X < FXData^[iEst]) then
begin
{FXData^[iLow] < X < FXData^[iEst]}
if ((X-FXData^[iLow]) < (FXData^[iEst]-X)) then
begin
iEst := iLow;
end;
end
else
begin
{FXData^[iEst] < X < FXData^[iHigh]}
if ((FXData^[iEst]-X) > (FXData^[iHigh]-X)) then
begin
iEst := iHigh;
end;
end;
GetNearestPointToX := iEst;
end;
{------------------------------------------------------------------------------
Function: TSeries.GetNearestPieSlice
Description: does what it says
Author: Mat Ballard
Date created: 01/25/2001
Date modified: 01/25/2001 by Mat Ballard
Purpose: data management
Return Value: Index of nearest point
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetNearestPieSlice(
iX, iY,
PieLeft, PieTop, PieWidth, PieHeight: Integer;
var MinDistance: Single): Integer;
var
i, NearestN: Integer;
Xi, Yi, Ri: Integer;
Angle,
AngleSum,
TheAngle,
Ratio,
Sum: Single;
begin
GetNearestPieSlice := 0;
{adjust for displacement:}
Dec(iX, FDeltaX);
Dec(iY, FDeltaY);
{et al:}
if (MinDistance = 0) then
MinDistance := 1.0e38;
NearestN := 0;
if ((iX < PieLeft) or
(iX > (PieLeft + PieWidth)) or
(iY < PieTop) or
(iY > (PieTop + PieHeight))) then
exit;
{X and Y distances from centre of ellipse:}
Xi := iX - (PieLeft + PieWidth div 2);
Yi := iY - (PieTop + PieHeight div 2);
MinDistance := Sqrt(Sqr(Xi) + Sqr(Yi));
Ratio := PieWidth / PieHeight;
Sum := Sqr(Xi) + Sqr(Ratio)*Sqr(Yi);
Ri := Sqr(PieWidth div 2);
if (Round(Sum) <= Ri) then
begin
TheAngle := GetAngle(Xi, Yi);
AngleSum := 0;
for i := 0 to FNoPts-1 do
begin
{angles are in radians, of course:}
Angle := TWO_PI * FYData^[i] / YSum;
AngleSum := AngleSum + Angle;
if (AngleSum >= TheAngle) then
begin
NearestN := i;
MinDistance := 0;
break;
end;
end;
end;
GetNearestPieSlice := NearestN;
end;
{------------------------------------------------------------------------------
Function: TSeries.GetNearestXYPoint
Description: does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 01/25/2001 by Mat Ballard
Purpose: data management
Return Value: Index of nearest point
Known Issues:
------------------------------------------------------------------------------}
function TSeries.GetNearestXYPoint(
iX, iY,
StartPt, EndPt: Integer;
var MinDistance: Single): Integer;
{The data may not be sorted, so we check every point:}
var
Distance: Single;
i, NearestN: Integer;
Xi, Yi: Integer;
begin
{adjust for displacement:}
Dec(iX, FDeltaX);
Dec(iY, FDeltaY);
{check the incoming value:}
if (MinDistance = 0) then
MinDistance := 1.0e38;
NearestN := 0;
if (StartPt = EndPt) then
begin
StartPt := 0;
EndPt := FNoPts-1;
end;
{loop over points in each series:}
for i := StartPt to EndPt do
begin
Xi := FXAxis.FofX(FXData^[i]);
Yi := FYAxis.FofY(FYData^[i]);
Distance := Sqrt(Sqr(Int(Xi-iX)) + Sqr(Int(Yi-iY)));
if (MinDistance > Distance) then
begin
MinDistance := Distance;
NearestN := i;
end;
end; {loop over points}
//MinDistance := Sqrt(MinDistance);
GetNearestXYPoint := NearestN;
end;
{------------------------------------------------------------------------------
Function: TSeries.GetNearestXYPointFast
Description: does what it says - a quick and dirty method
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management
Return Value: Index of nearest point
Known Issues: will not work on very spiky data
------------------------------------------------------------------------------}
function TSeries.GetNearestXYPointFast(
iX, iY: Integer;
var MinDistance: Single): Integer;
var
X: Single;
N: Integer;
StartPt, EndPt: Integer;
begin
X := FXAxis.XofF(iX);
N := GetNearestPointToX(X);
StartPt := N - FNoPts div 20;
if (StartPt < 0) then StartPt := 0;
EndPt := N + FNoPts div 20;
if (EndPt > FNoPts) then EndPt := FNoPts;
GetNearestXYPointFast := GetNearestXYPoint(
iX, iY,
StartPt, EndPt,
MinDistance);
end;
{TSeries the movie ! ----------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TSeries.Draw
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 05/06/2001 by Mat Ballard
Purpose: draws the Series on a given canvas
Known Issues: PERFORMANCE stuff now removed - I know TPlot is quick !
------------------------------------------------------------------------------}
procedure TSeries.Draw(ACanvas: TCanvas; XYFastAt: Integer);
var
i: Integer;
iX, iXOld, iY, iYMin, iYMax: Integer;
TheYMin, TheYMax: Single;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.Draw: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
ACanvas.Pen.Assign(FPen);
ACanvas.Brush.Assign(FBrush);
if (ACanvas.Pen.Width > 0) then
begin
if (FNoPts < XYFastAt) then
begin
iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
ACanvas.MoveTo(iX, iY);
for i := 1 to FNoPts-1 do
begin
iX := FXAxis.FofX(FXData^[i]) + FDeltaX;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
ACanvas.LineTo(iX, iY);
end; {loop over points}
end
else
begin
{There is a huge number of points (> 10000).
We therefore adopt a new drawing procedure:
TPlot TChart
Fast Slow Memory Time Memory
(ms) (ms) (K) (ms) (K)
9990 pts: 108 ---- 2902 204 2668
10001 pts: 13.9 16.2 2976
100000 pts: 23.4 67.7 3628 2226 6000
1000000 pts: 123 ms 592 10736 19271 41040
{This is the more accurate but slower algorithm:}
i := 0;
iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
ACanvas.MoveTo(iX, iY);
while i < FNoPts do
begin
iXOld := iX;
TheYMin := FYData^[i];
TheYMax := TheYMin;
repeat
iX := FXAxis.FofX(FXData^[i])+ FDeltaX;
if (iX > iXOld) then break;
if (TheYMin > FYData^[i]) then
TheYMin := FYData^[i];
if (TheYMax < FYData^[i]) then
TheYMax := FYData^[i];
Inc(i);
until (i = FNoPts-1);
iYMin := FYAxis.FofY(TheYMin)+ FDeltaY;
iYMax := FYAxis.FofY(TheYMax)+ FDeltaY;
ACanvas.LineTo(iX, iYMax);
ACanvas.LineTo(iX, iYMin);
Inc(i);
end;
end; {if FNoPts < XYFastAt}
end; {Pen.Width > 0}
if ((FSymbol <> syNone) and
(FSymbolSize > 0) and
(FNoPts < XYFastAt)) then
begin
ACanvas.Brush.Assign(FBrush);
for i := 0 to FNoPts-1 do
begin
iX := FXAxis.FofX(FXData^[i])+ FDeltaX;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
DrawSymbol(ACanvas, iX, iY);
end; {loop over points}
end;
if (FHighCount > 0) then
if (FHighLow <> []) then
DrawHighs(ACanvas);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawShades
Description: Drawing procedure exyension
Author: Mat Ballard
Date created: 07/23/2001
Date modified: 07/23/2001 by Mat Ballard
Purpose: draws the portion of a Series that exceeds the axis limits on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DrawShades(ACanvas: TCanvas; XYFastAt: Integer);
var
i: Integer;
iX, iXOld, iXCalc, iY, iYOld: Integer;
LowerLimit, UpperLimit: Integer;
Slope, Intercept: Single;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.DrawShades: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
if (FNoPts >= XYFastAt) then exit;
ACanvas.Pen.Assign(FPen);
ACanvas.Brush.Assign(FBrush);
if (FShadeLimits) then
begin
ACanvas.Pen.Style := psClear;
LowerLimit := FYAxis.FofY(FYAxis.LimitLower);
UpperLimit := FYAxis.FofY(FYAxis.LimitUpper);
iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
for i := 1 to FNoPts-1 do
begin
iXOld := iX;
iYOld := iY;
iX := FXAxis.FofX(FXData^[i]) + FDeltaX;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
if (iY > LowerLimit) then
begin
if (iYOld >= LowerLimit) then
ACanvas.Polygon([
Point(iXOld, iYOld),
Point(iXOld, LowerLimit),
Point(iX, LowerLimit),
Point(iX, iY)])
else
begin
Slope := (iY-iYOld) / (iX-iXOld);
Intercept := iY - Slope * iX;
iXCalc := Round((LowerLimit - Intercept) / Slope);
ACanvas.Polygon([
Point(iXCalc, LowerLimit),
Point(iX, LowerLimit),
Point(iX, iY)])
end;
end
else if (iY < UpperLimit) then
begin
if (iYOld <= UpperLimit) then
ACanvas.Polygon([
Point(iXOld, iYOld),
Point(iXOld, UpperLimit),
Point(iX, UpperLimit),
Point(iX, iY)])
else
begin
Slope := (iY-iYOld) / (iX-iXOld);
Intercept := iY - Slope * iX;
iXCalc := Round((UpperLimit - Intercept) / Slope);
ACanvas.Polygon([
Point(iXCalc, UpperLimit),
Point(iX, UpperLimit),
Point(iX, iY)])
end
end
else if (iYOld > LowerLimit) then
begin
Slope := (iY-iYOld) / (iX-iXOld);
Intercept := iY - Slope * iX;
iXCalc := Round((LowerLimit - Intercept) / Slope);
ACanvas.Polygon([
Point(iXCalc, LowerLimit),
Point(iXOld, LowerLimit),
Point(iXOld, iYOld)])
end
else if (iYOld < UpperLimit) then
begin
Slope := (iY-iYOld) / (iX-iXOld);
Intercept := iY - Slope * iX;
iXCalc := Round((UpperLimit - Intercept) / Slope);
ACanvas.Polygon([
Point(iXCalc, UpperLimit),
Point(iXOld, UpperLimit),
Point(iXOld, iYOld)])
end; {iY or iYOld in Limits}
end; {loop over points}
ACanvas.Pen.Style := FPen.Style;
end; {Shaded}
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawPie
Description: standard Pie Drawing procedure
Author: Mat Ballard
Date created: 12/21/2000
Date modified: 12/21/2000 by Mat Ballard
Purpose: draws the Series on a given canvas as a Pie
Known Issues:
------------------------------------------------------------------------------}
{ Equation of an ellipse, origin at (h, k), with x-radius a and y-radius b is:
(x - h)^2 (y - k)^2
---------- + ---------- = 1
a^2 b^2
The polar version of this equation is:
r = 1 / Sqrt(Cos^2╪/a^2 + Sin^2╪/b^2)
where:
a^2 = b^2 + c^2 c is the focus
x = r Cos ╪
y = r Sin ╪
}
procedure TSeries.DrawPie(
ACanvas: TCanvas;
PieLeft,
PieTop,
PieWidth,
PieHeight: Integer);
var
a, b, d,
i, j, Index, TextIndex, WallIndex,
iAngleSum, iOldAngleSum,
NoTopPts,
StartSolid, EndSolid,
StringWidth: Integer;
TextAngle,
TheSin, TheCos: Extended;
Angle, AngleSum, OldAngleSum,
PolarAngle,
Radius, Ratio: Single;
IsWall, DoAmount: Boolean;
Points: TPoints;
pPoints: pTPoints;
AngleSumPos, TextPos, DeltaPos: TPoint;
TheText: String;
{Note: this function only works for values of Angle between 0 and 360.}
function PolarRadians(AnAngle: Extended): Extended;
var
TheResult: Extended;
begin
TheResult := 90.0 - AnAngle;
if (TheResult < 0) then
TheResult := TheResult + 360.0;
PolarRadians := TWO_PI * TheResult / 360;
end;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.Draw: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
ACanvas.Pen.Assign(FPen);
ACanvas.Brush.Assign(FBrush);
ACanvas.Font.Assign(FXAxis.Labels.Font);
if (Self.ExternalXSeries) then
Self.FXStringData := Self.FXDataSeries.XStringData;
{Get the total; note Abs() - negative sectors are bad news:}
YSum := 0;
for i := 0 to FNoPts-1 do
YSum := YSum + Abs(FYData^[i]);
{Points[0] is the centre of the ellipse:}
Points[0].x := PieLeft + PieWidth div 2 + FDeltaX;
Points[0].y := PieTop + PieHeight div 2 + FDeltaY;
{a is the horizontal major axis length}
a := PieWidth div 2;
{b is the vertical minor axis length}
b := PieHeight div 2;
{c is the distance of the focus from the centre:}
d := a - b;
if (d > PieHeight div 5) then
d := PieHeight div 5;
IsWall := FALSE;
{This is the angle, in degrees, from 12 o'clock, clockwise:}
AngleSum := 0;
OldAngleSum := 0;
iOldAngleSum := 0;
AngleSumPos.x := Points[0].x;
AngleSumPos.y := Points[0].y - b;
for i := 0 to FNoPts-1 do
begin
Index := 1;
StartSolid := -1;
EndSolid := -1;
if (iOldAngleSum < OldAngleSum) then
begin
Points[Index].x := AngleSumPos.x;
Points[Index].y := AngleSumPos.y;
{only angles between 90 and 270 - the lower side of the ellipse -
can have a "wall":}
if ((90 <= OldAngleSum) and (OldAngleSum <= 270)) then
StartSolid := Index;
Inc(Index);
end;
ACanvas.Brush.Color := MyColorValues[1 + i mod 15];
Angle := 360.0 * Abs(FYData^[i]) / YSum;
AngleSum := AngleSum + Angle;
iAngleSum := Trunc(AngleSum);
for j := iOldAngleSum to iAngleSum do
begin
{we look for start of the "wall":}
if ((StartSolid < 0) and (90 <= j) and (j <= 270)) then
StartSolid := Index;
{gotta find the start before the end:}
if ((StartSolid > 0) and (j <= 270)) then
EndSolid := Index;
PolarAngle := PolarRadians(j);
SinCos(PolarAngle, TheSin, TheCos);
Radius := 1.0 / Sqrt(Sqr(TheCos/a) + Sqr(TheSin/b));
AngleSumPos.x := Points[0].x + Round(Radius * TheCos);
AngleSumPos.y := Points[0].y - Round(Radius * TheSin);
Points[Index].x := AngleSumPos.x;
Points[Index].y := AngleSumPos.y;
Inc(Index);
end;
if (iAngleSum < AngleSum) then
begin
if ((StartSolid > 0) and (AngleSum <= 270)) then
EndSolid := Index;
PolarAngle := PolarRadians(AngleSum);
SinCos(PolarAngle, TheSin, TheCos);
Radius := 1.0 / Sqrt(Sqr(TheCos/a) + Sqr(TheSin/b));
AngleSumPos.x := Points[0].x + Round(Radius * TheCos);
AngleSumPos.y := Points[0].y - Round(Radius * TheSin);
Points[Index].x := AngleSumPos.x;
Points[Index].y := AngleSumPos.y;
Inc(Index);
end;
{Draw the pie slice:}
ACanvas.Polygon(Slice(Points, Index));
TextAngle := OldAngleSum + Angle/2;
{Should we put the amounts in ?}
j := Round(Sqrt(
Sqr(Points[1].x - Points[Index-1].x) +
Sqr(Points[1].y - Points[Index-1].y)));
TheText := FloatToStrF(100 * FYData^[i] / YSum, ffFixed, 0, 0) + '%';
StringWidth := ACanvas.TextWidth(TheText);
DoAmount := (j > StringWidth);
{NB: we do this before the wall section because the latter changes the Points array,
however, we do the textout after the wall because of brush and color issues.}
{Draw the bottom wall:}
if ((d > 0) and (StartSolid > 0) and (EndSolid > 0)) then
begin
IsWall := TRUE;
ACanvas.Brush.Color := Misc.GetDarkerColor(MyColorValues[1 + i mod 15], 50);
pPoints := @Points[StartSolid];
NoTopPts := EndSolid - StartSolid + 1;
WallIndex := NoTopPts;
for j := NoTopPts-1 downto 0 do
begin
pPoints^[WallIndex].x := pPoints^[j].x;
pPoints^[WallIndex].y := pPoints^[j].y + d;
Inc(WallIndex);
end;
{Draw the pie wall:}
ACanvas.Polygon(Slice(pPoints^, 2 * NoTopPts));
end;
{Set brush up for text mode:}
ACanvas.Brush.Style := bsClear;
{Should we put the amounts in ?
See above}
if (DoAmount) then
begin
ACanvas.Font.Color := GetInverseColor(MyColorValues[1 + i mod 15]);
TextPos := Points[Index div 2];
DeltaPos.x := Points[0].x - TextPos.x;
DeltaPos.y := Points[0].y - TextPos.y;
j := Round(Sqrt(Sqr(DeltaPos.x) + Sqr(DeltaPos.y)));
Ratio := StringWidth / j;
DeltaPos.x := Round(Ratio * DeltaPos.x);
DeltaPos.y := Round(Ratio * DeltaPos.y);
TextPos.x := TextPos.x + DeltaPos.x - StringWidth div 2;
TextPos.y := TextPos.y + DeltaPos.y - ACanvas.TextHeight(TheText) div 2;
ACanvas.TextOut(TextPos.x, TextPos.y, TheText);
end;
{Is the X Data is in the form of a string ?}
if (FXStringData <> nil) then
begin
if (i < FXStringData.Count) then
begin
if (Angle > 6.0) then {6 degrees}
begin
{There is a large enough amount to denote:}
ACanvas.Font.Color := MyColorValues[1 + i mod 15];
TextPos := Points[Index div 2];
{put the text outside the circle:}
if (TextAngle > 180) then
Dec(TextPos.x, ACanvas.TextWidth(FXStringData.Strings[i]));
if ((TextAngle < 90) or (TextAngle > 270)) then
Dec(TextPos.y, ACanvas.TextHeight('Ap'))
else if (IsWall) then
Inc(TextPos.y, d);
ACanvas.TextOut(TextPos.x, TextPos.y, FXStringData.Strings[i]);
{restore brush:}
ACanvas.Brush.Style := FBrush.Style;
end; {Angle > 0.1}
end; {there is a string}
end; {stringdata}
iOldAngleSum := iAngleSum;
OldAngleSum := AngleSum;
//Application.ProcessMessages;
end; {for i}
{restore the string pointer:}
if (Self.ExternalXSeries) then
Self.FXStringData := nil;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawPolar
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 01/25/2001
Date modified: 01/25/2001 by Mat Ballard
Purpose: draws the Series on a given canvas as a Polar graph
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DrawPolar(ACanvas: TCanvas; PolarRange: Single);
var
i: Integer;
iX, iY: Integer;
Angle,
X,
Y: Single;
SinTheta, CosTheta: Extended;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.Draw: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
ACanvas.Pen.Assign(FPen);
ACanvas.Brush.Assign(FBrush);
if (ACanvas.Pen.Width > 0) then
begin
Angle := TWO_PI * FXData^[0] / PolarRange;
SinCos(Angle, SinTheta, CosTheta);
X := SinTheta * FYData^[0];
Y := CosTheta * FYData^[0];
iX := FXAxis.FofX(X);
iY := FYAxis.FofY(Y);
ACanvas.MoveTo(iX, iY);
for i := 1 to FNoPts-1 do
begin
Angle := TWO_PI * FXData^[i] / PolarRange;
SinCos(Angle, SinTheta, CosTheta);
X := SinTheta * FYData^[i];
Y := CosTheta * FYData^[i];
iX := FXAxis.FofX(X);
iY := FYAxis.FofY(Y);
ACanvas.LineTo(iX, iY);
if ((FSymbol <> syNone) and (FSymbolSize > 0)) then
DrawSymbol(ACanvas, iX, iY);
end; {loop over points}
end;
{if (FHighCount > 0) then
if (FHighLow <> []) then
DrawHighs(ACanvas);}
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Trace
Description: Draws the series in an erasable mode
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: rapidly changing screen display
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Trace(ACanvas: TCanvas);
var
i: Integer;
iX, iY: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.Trace: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
ACanvas.Pen.Assign(FPen);
ACanvas.Pen.Mode := pmNotXOR;
iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
ACanvas.MoveTo(iX, iY);
for i := 1 to FNoPts-1 do
begin
iX := FXAxis.FofX(FXData^[i]) + FDeltaX;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
ACanvas.LineTo(iX, iY);
end; {loop over points}
if ((FSymbol <> syNone) and (FSymbolSize > 0)) then
begin
ACanvas.Brush.Assign(FBrush);
for i := 0 to FNoPts-1 do
begin
iX := FXAxis.FofX(FXData^[i])+ FDeltaX;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
DrawSymbol(ACanvas, iX, iY);
end; {loop over points}
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawHighs
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: draws the Highs of the Series on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DrawHighs(ACanvas: TCanvas);
var
i,
iX,
iY: Integer;
TheValue: String;
{$IFDEF MSWINDOWS}
LogRec: TLogFont;
OldFontHandle, NewFontHandle: hFont;
{$ENDIF}
begin
ACanvas.Font.Color := ACanvas.Pen.Color;
{$IFDEF MSWINDOWS}
GetObject(ACanvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
LogRec.lfEscapement := 900; {Up}
LogRec.lfOrientation := LogRec.lfEscapement;
{LogRec.lfOutPrecision := OUT_DEFAULT_PRECIS;}
NewFontHandle := CreateFontIndirect(LogRec);
{select the new font:}
OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
{$ENDIF}
{$IFDEF LINUX}
{$ENDIF}
{Loop over all Highs:}
if (hlHigh in FHighLow) then
begin
for i := 0 to FHighCount-1 do
begin
iX := FXAxis.FofX(FXData^[FHighs^[i]]);
iY := FYAxis.FofY(FYData^[FHighs^[i]]);
ACanvas.MoveTo(iX, iY-2);
ACanvas.LineTo(iX, iY + ACanvas.Font.Height);
{$IFDEF MSWINDOWS}
ACanvas.TextOut(
iX + ACanvas.Font.Height div 2,
iY + ACanvas.Font.Height,
FXAxis.LabelToStrF(FXData^[FHighs^[i]]));
{$ENDIF}
{$IFDEF LINUX}
ACanvas.TextOut(
iX + ACanvas.Font.Height div 2,
iY + ACanvas.Font.Height + Abs(ACanvas.Font.Height),
FXAxis.LabelToStrF(FXData^[FHighs^[i]]));
{$ENDIF}
end;
end;
{Loop over all Lows:}
if (hlLow in FHighLow) then
begin
for i := 0 to FLowCount-1 do
begin
iX := FXAxis.FofX(FXData^[FLows^[i]]);
iY := FYAxis.FofY(FYData^[FLows^[i]]);
ACanvas.MoveTo(iX, iY+2);
ACanvas.LineTo(iX, iY - ACanvas.Font.Height);
TheValue := FXAxis.LabelToStrF(FXData^[FLows^[i]]);
{$IFDEF MSWINDOWS}
ACanvas.TextOut(
iX + ACanvas.Font.Height div 2,
iY - ACanvas.Font.Height + ACanvas.TextWidth(TheValue),
TheValue);
{$ENDIF}
{$IFDEF LINUX}
ACanvas.TextOut(
iX + ACanvas.Font.Height div 2,
iY - ACanvas.Font.Height + ACanvas.TextWidth(TheValue) + Abs(ACanvas.Font.Height),
TheValue);
{$ENDIF}
end;
end;
{$IFDEF MSWINDOWS}
{go back to original font:}
NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
{and delete the old one:}
DeleteObject(NewFontHandle);
{$ENDIF}
{$IFDEF LINUX}
{$ENDIF}
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawHistory
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: draws the Series on a given canvas IN HISTORY MODE
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DrawHistory(ACanvas: TCanvas; HistoryX: Single);
var
i: Integer;
iX, iY: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeries.DrawHistory: ' + sACanvasIsNil);
{$ENDIF}
if ((not FVisible) or
(FNoPts = 0)) then exit;
ACanvas.Pen.Assign(FPen);
{we set the pen mode so that a second call to DrawHistory
erases the curve on screen:}
ACanvas.Pen.Mode := pmNotXOR;
iX := FXAxis.FofX(0) + FDeltaX;
iY := FYAxis.FofY(FYData^[FNoPts-1]) + FDeltaY;
ACanvas.MoveTo(iX, iY);
for i := FNoPts-2 downto 0 do
begin
iX := FXAxis.FofX(FXData^[i] - FXData^[FNoPts-1]) + FDeltaX;
{we leave this loop if this is the last point:}
if (iX < FXAxis.Left) then break;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
ACanvas.LineTo(iX, iY);
end; {loop over points}
if ((FSymbol <> syNone) and (FSymbolSize > 0)) then
begin
ACanvas.Brush.Assign(FBrush);
for i := FNoPts-2 downto 0 do
begin
iX := FXAxis.FofX(FXData^[i] - FXData^[FNoPts-1])+ FDeltaX;
{we leave this loop if this is the last point:}
if (iX < FXAxis.Left) then break;
iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
DrawSymbol(ACanvas, iX, iY);
end; {loop over points}
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.DrawSymbol
Description: Draws the selected Symbol at each point
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 03/01/2001 by Mat Ballard
Purpose: draws the Symbols of the Series on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.DrawSymbol(ACanvas: TCanvas; iX, iY: Integer);
begin
case FSymbol of
syDash:
begin
ACanvas.MoveTo(iX - FSymbolSize, iY);
ACanvas.LineTo(iX + FSymbolSize+1, iY);
end;
syVertDash:
begin
ACanvas.MoveTo(iX, iY - FSymbolSize);
ACanvas.LineTo(iX, iY + FSymbolSize+1);
end;
syLeftDash:
begin
ACanvas.MoveTo(iX, iY - FSymbolSize);
ACanvas.LineTo(iX, iY + FSymbolSize+1);
ACanvas.MoveTo(iX, iY);
ACanvas.LineTo(iX - FSymbolSize, iY);
end;
syRightDash:
begin
ACanvas.MoveTo(iX, iY - FSymbolSize);
ACanvas.LineTo(iX, iY + FSymbolSize+1);
ACanvas.MoveTo(iX, iY);
ACanvas.LineTo(iX + FSymbolSize+1, iY);
end;
syPlus:
begin
ACanvas.MoveTo(iX - FSymbolSize, iY);
ACanvas.LineTo(iX + FSymbolSize+1, iY);
ACanvas.MoveTo(iX, iY - FSymbolSize);
ACanvas.LineTo(iX, iY + FSymbolSize+1);
end;
syCross:
begin
ACanvas.MoveTo(iX - FSymbolSize, iY - FSymbolSize);
ACanvas.LineTo(iX + FSymbolSize+1, iY + FSymbolSize+1);
ACanvas.MoveTo(iX + FSymbolSize, iY - FSymbolSize);
ACanvas.LineTo(iX - FSymbolSize-1, iY + FSymbolSize+1);
end;
syStar:
begin
ACanvas.MoveTo(iX - FSymbolSize, iY);
ACanvas.LineTo(iX + FSymbolSize+1, iY);
ACanvas.MoveTo(iX, iY - FSymbolSize);
ACanvas.LineTo(iX, iY + FSymbolSize+1);
ACanvas.MoveTo(iX - FSymbolSize, iY - FSymbolSize);
ACanvas.LineTo(iX + FSymbolSize+1, iY + FSymbolSize+1);
ACanvas.MoveTo(iX + FSymbolSize, iY - FSymbolSize);
ACanvas.LineTo(iX - FSymbolSize-1, iY + FSymbolSize+1);
end;
sySquare:
begin
ACanvas.Rectangle(iX - FSymbolSize, iY - FSymbolSize,
iX + FSymbolSize+1, iY + FSymbolSize+1)
end;
syCircle:
begin
ACanvas.Ellipse(iX - FSymbolSize, iY - FSymbolSize,
iX + FSymbolSize+1, iY + FSymbolSize+1)
end;
syUpTriangle:
begin
ACanvas.Polygon([
Point(iX - FSymbolSize, iY + FSymbolSize+1),
Point(iX, iY - FSymbolSize),
Point(iX + FSymbolSize, iY + FSymbolSize+1)]);
end;
syDownTriangle:
begin
ACanvas.Polygon([
Point(iX - FSymbolSize, iY - FSymbolSize),
Point(iX, iY + FSymbolSize+1),
Point(iX + FSymbolSize, iY - FSymbolSize)]);
end;
end;
ACanvas.MoveTo(iX, iY);
end;
{Moving TSeries on the screen -------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TSeries.GenerateColumnOutline
Description: calculates an Outline of the Series
Author: Mat Ballard
Date created: 02/26/2001
Date modified: 02/26/2001 by Mat Ballard
Purpose: Screen display - highlighting a Series
Known Issues: This records the position of a single "point"
------------------------------------------------------------------------------}
procedure TSeries.GenerateColumnOutline(X1, Y1, X2, Y2: Integer);
begin
TheOutline[0].x := X1;
TheOutline[0].y := Y1;
TheOutline[1].x := X2;
TheOutline[1].y := Y2;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.GeneratePieOutline
Description: calculates an Outline of the Series
Author: Mat Ballard
Date created: 02/26/2001
Date modified: 02/26/2001 by Mat Ballard
Purpose: Screen display - highlighting a Series
Known Issues: This records the position of the entire ellipse
------------------------------------------------------------------------------}
procedure TSeries.GeneratePieOutline(
PieLeft,
PieTop,
PieWidth,
PieHeight,
TheNearestPoint: Integer);
var
i: Integer;
Radius: Single;
Angle,
AngleSum,
TheSin, TheCos: Extended;
Centre: TPoint;
begin
TheOutline[0].x := PieLeft;
TheOutline[0].y := PieTop;
TheOutline[1].x := PieLeft + PieWidth;
TheOutline[1].y := PieTop + PieHeight;
Centre.x := PieLeft + PieWidth div 2;
Centre.y := PieTop + PieHeight div 2;
Radius := PieWidth / 2.0;
TheOutline[2].x := Centre.x;
TheOutline[2].y := PieTop;
AngleSum := 0;
{work our way around the circle:}
for i := 0 to TheNearestPoint do
begin
TheOutline[3].x := TheOutline[2].x;
TheOutline[3].y := TheOutline[2].y;
{angles are in radians, of course:}
Angle := TWO_PI * FYData^[i] / YSum;
AngleSum := AngleSum + Angle;
SinCos(AngleSum, TheSin, TheCos);
TheOutline[2].x := Centre.x + Round(Radius * TheSin);
TheOutline[2].y := Centre.y - Round(Radius * TheCos);
{ACanvas.Pie(
PieLeft + FDeltaX, PieTop + FDeltaY,
PieRight + FDeltaX, PieBottom + FDeltaY,
TheOutline[2].x + FDeltaX, TheOutline[2].y + FDeltaY,
TheOutline[3].x + FDeltaX, TheOutline[3].y + FDeltaY);}
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.GenerateXYOutline
Description: calculates an Outline of the Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Screen display - highlighting a Series
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.GenerateXYOutline;
var
i: Integer;
StepSize: Integer;
begin
if (FNoPts > OUTLINE_DENSITY) then
begin
{initialize:}
NoOutlinePts := OUTLINE_DENSITY+1; { = 21}
StepSize := FNoPts div OUTLINE_DENSITY;
{loop over data points:}
for i := 0 to NoOutlinePts-2 do {0..19}
begin
TheOutline[i].x := FXAxis.FofX(FXData^[i*StepSize]);
TheOutline[i].y := FYAxis.FofY(FYData^[i*StepSize]);
end;
{do the end point:}
TheOutline[OUTLINE_DENSITY].x := FXAxis.FofX(FXData^[FNoPts-1]);
TheOutline[OUTLINE_DENSITY].y := FYAxis.FofY(FYData^[FNoPts-1]);
end
else
begin
{not many points:}
NoOutlinePts := FNoPts;
for i := 0 to NoOutlinePts-1 do
begin
TheOutline[i].x := FXAxis.FofX(FXData^[i]);
TheOutline[i].y := FYAxis.FofY(FYData^[i]);
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.Outline
Description: draws an Outline of the Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Screen display - highlighting a Series
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.Outline(
ACanvas: TCanvas;
ThePlotType: TPlotType;
TheOutlineWidth: Integer);
var
i: Integer;
{pOutlinePt: pPoint;}
begin
ACanvas.Pen.Color := clLime;
ACanvas.Pen.Width := TheOutlineWidth;
ACanvas.Pen.Mode := pmNotXOR;
{ACanvas.Pen.Style := psDash;}
case ThePlotType of
ptXY, ptError, ptMultiple, ptBubble:
begin
if (NoOutlinePts = 0) then exit;
ACanvas.MoveTo(TheOutline[0].x + FDeltaX, TheOutline[0].y + FDeltaY);
for i := 0 to NoOutlinePts-1 do
begin
ACanvas.LineTo(TheOutline[i].x + FDeltaX, TheOutline[i].y + FDeltaY);
end;
end;
ptColumn, ptStack, ptNormStack:
ACanvas.Rectangle(
TheOutline[0].x,
TheOutline[0].y,
TheOutline[1].x,
TheOutline[1].y);
ptPie:
begin
ACanvas.Ellipse(
TheOutline[0].x + FDeltaX,
TheOutline[0].y + FDeltaY,
TheOutline[1].x + FDeltaX,
TheOutline[1].y + FDeltaY);
ACanvas.Pen.Width := TheOutlineWidth div 2;
ACanvas.Pie(
TheOutline[0].x + FDeltaX, TheOutline[0].y + FDeltaY,
TheOutline[1].x + FDeltaX, TheOutline[1].y + FDeltaY,
TheOutline[2].x + FDeltaX, TheOutline[2].y + FDeltaY,
TheOutline[3].x + FDeltaX, TheOutline[3].y + FDeltaY);
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeries.MoveBy
Description: does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: moves the clicked object Outline by (DX, DY) from its current point.
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.MoveBy(ACanvas: TCanvas; ThePlotType: TPlotType; DX, DY, TheOutlineWidth: Integer);
begin
{erase the old Outline:}
Outline(ACanvas, ThePlotType, TheOutlineWidth);
{save the new displacements:}
Inc(FDeltaX, DX);
Inc(FDeltaY, DY);
{create the new Outline:}
Outline(ACanvas, ThePlotType, TheOutlineWidth);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.MoveTo
Description: does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: moves the clicked object Outline TO (X, Y).
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.MoveTo(
ACanvas: TCanvas;
ThePlotType: TPlotType;
TheOutlineWidth,
X, Y: Integer); {by how much}
begin
{erase the old Outline:}
Outline(ACanvas, ThePlotType, TheOutlineWidth);
{save the new displacements:}
FDeltaX := X - FXAxis.FofX(FXData^[0]);
FDeltaY := Y - FYAxis.FofY(FYData^[0]);
{create the new Outline:}
Outline(ACanvas, ThePlotType, TheOutlineWidth);
end;
{------------------------------------------------------------------------------
Procedure: TSeries.LineBestFit
Description: Does what it says
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: calculates the line of best fit from Start to Finish
Known Issues:
------------------------------------------------------------------------------}
procedure TSeries.LineBestFit(TheLeft, TheRight: Single;
var NoLSPts: Integer;
var SumX, SumY, SumXsq, SumXY, SumYsq: Double;
var Slope, Intercept, Rsq: Single);
var
i: Integer;
Start, Finish: Integer;
LnX, LnY: Double;
begin
{Determine the starting and ending points:}
Start := GetNearestPointToX(TheLeft);
Finish := GetNearestPointToX(TheRight);
if ((not FXAxis.LogScale) and (not FYAxis.LogScale)) then
begin
{normal linear fit:}
for i := Start to Finish do
begin
Inc(NoLSPts);
SumX := SumX + FXData^[i];
SumY := SumY + FYData^[i];
SumXsq := SumXsq + Sqr(FXData^[i]);
SumXY := SumXY + FXData^[i] * FYData^[i];
SumYsq := SumYsq + Sqr(FYData^[i]);
end;
end
else if ((FXAxis.LogScale) and (not FYAxis.LogScale)) then
begin
{logarithmic X Axis:}
for i := Start to Finish do
begin
Inc(NoLSPts);
LnX := Ln(FXData^[i]);
SumX := SumX + LnX;
SumY := SumY + FYData^[i];
SumXsq := SumXsq + Sqr(LnX);
SumXY := SumXY + LnX * FYData^[i];
SumYsq := SumYsq + Sqr(FYData^[i]);
end;
end
else if ((not FXAxis.LogScale) and (FYAxis.LogScale)) then
begin
{logarithmic Y Axis:}
for i := Start to Finish do
begin
Inc(NoLSPts);
LnY := Ln(FYData^[i]);
SumX := SumX + FXData^[i];
SumY := SumY + LnY;
SumXsq := SumXsq + Sqr(FXData^[i]);
SumXY := SumXY + FXData^[i] * LnY;
SumYsq := SumYsq + Sqr(LnY);
end;
end
else if ((FXAxis.LogScale) and (FYAxis.LogScale)) then
begin
{double logarithmic fit:}
for i := Start to Finish do
begin
Inc(NoLSPts);
LnX := Ln(FXData^[i]);
LnY := Ln(FYData^[i]);
SumX := SumX + LnX;
SumY := SumY + LnY;
SumXsq := SumXsq + Sqr(LnX);
SumXY := SumXY + LnX * LnY;
SumYsq := SumYsq + Sqr(LnY);
end;
end;
{so the slope and intercept are:}
try
Slope := (NoLSPts * SumXY - SumX * SumY) /
(NoLSPts * SumXsq - Sqr(SumX));
Intercept := (SumY / NoLSPts) - Slope * (SumX / NoLSPts);
RSQ := Sqr(NoLSPts * SumXY - SumX * SumY) /
((NoLSPts * SumXsq - Sqr(SumX)) * (NoLSPts * SumYsq - Sqr(SumY)));
except
EMathError.CreateFmt('NoLSPts = %d' + CRLF +
'SumX = %g' + CRLF +
'SumY = %g' + CRLF +
'SumXsq = %g' + CRLF +
'SumXY = %g' + CRLF +
'SumYsq = %g.',
[NoLSPts, SumX, SumY, SumXsq, SumXY, SumYsq]);
end;
end;
{Sub BestFit (iStart%, iFinish%, X_Data() As Single, Y_Data() As Single, Clear_Regs%, Slope!, Intercept!, RSQ!)
Dim i%
Dim Msg$
Static SumX!
Static SumY!
Static SumXsq!
Static SumXY!
Static SumYsq!
Static No_Pts%
On Error GoTo BestFit_ErrorHandler
' we initialise the sums for a least-squares fit:
If (Clear_Regs% = True) Then
No_Pts% = 0
SumX! = 0
SumY! = 0
SumXsq! = 0
SumXY! = 0
SumYsq! = 0
End If
Select Case LogCase()
Case 0 'neither axis is logged:
' Do the summation:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + X_Data(i%)
SumY! = SumY! + Y_Data(i%)
SumXsq! = SumXsq! + X_Data(i%) ^ 2
SumXY! = SumXY! + X_Data(i%) * Y_Data(i%)
SumYsq! = SumYsq! + Y_Data(i%) ^ 2
Next i%
Case 1 'only the X-axis is logged:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + Log(X_Data(i%))
SumY! = SumY! + Y_Data(i%)
SumXsq! = SumXsq! + Log(X_Data(i%)) ^ 2
SumXY! = SumXY! + Log(X_Data(i%)) * Y_Data(i%)
SumYsq! = SumYsq! + Y_Data(i%) ^ 2
Next i%
Case 2 'only the Y-axis is logged:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + X_Data(i%)
SumY! = SumY! + Log(Y_Data(i%))
SumXsq! = SumXsq! + X_Data(i%) ^ 2
SumXY! = SumXY! + X_Data(i%) * Log(Y_Data(i%))
SumYsq! = SumYsq! + Log(Y_Data(i%)) ^ 2
Next i%
Case 3 'both axes are logged:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + Log(X_Data(i%))
SumY! = SumY! + Log(Y_Data(i%))
SumXsq! = SumXsq! + Log(X_Data(i%)) ^ 2
SumXY! = SumXY! + Log(X_Data(i%)) * Log(Y_Data(i%))
SumYsq! = SumYsq! + Log(Y_Data(i%)) ^ 2
Next i%
Case 4 'X axis is Log10'ed
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + LOG10_E * Log(X_Data(i%))
SumY! = SumY! + Y_Data(i%)
SumXsq! = SumXsq! + (LOG10_E * Log(X_Data(i%))) ^ 2
SumXY! = SumXY! + LOG10_E * Log(X_Data(i%)) * Y_Data(i%)
SumYsq! = SumYsq! + Y_Data(i%) ^ 2
Next i%
Case 6 'X axis is Log10'ed, Y axis is ln'ed:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + LOG10_E * Log(X_Data(i%))
SumY! = SumY! + Log(Y_Data(i%))
SumXsq! = SumXsq! + (LOG10_E * Log(X_Data(i%))) ^ 2
SumXY! = SumXY! + LOG10_E * Log(X_Data(i%)) * Log(Y_Data(i%))
SumYsq! = SumYsq! + Log(Y_Data(i%)) ^ 2
Next i%
Case 8 'Y axis is Log10'ed:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + X_Data(i%)
SumY! = SumY! + LOG10_E * Log(Y_Data(i%))
SumXsq! = SumXsq! + X_Data(i%) ^ 2
SumXY! = SumXY! + X_Data(i%) * LOG10_E * Log(Y_Data(i%))
SumYsq! = SumYsq! + (LOG10_E * Log(Y_Data(i%))) ^ 2
Next i%
Case 9 'X axis is ln'ed, Y axis is Log10'ed:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + Log(X_Data(i%))
SumY! = SumY! + LOG10_E * Log(Y_Data(i%))
SumXsq! = SumXsq! + Log(X_Data(i%)) ^ 2
SumXY! = SumXY! + Log(X_Data(i%)) * LOG10_E * Log(Y_Data(i%))
SumYsq! = SumYsq! + (LOG10_E * Log(Y_Data(i%))) ^ 2
Next i%
Case 12 'both axes are Log10'ed:
For i% = iStart% To iFinish%
No_Pts% = No_Pts% + 1
SumX! = SumX! + LOG10_E * Log(X_Data(i%))
SumY! = SumY! + LOG10_E * Log(Y_Data(i%))
SumXsq! = SumXsq! + (LOG10_E * Log(X_Data(i%))) ^ 2
SumXY! = SumXY! + LOG10_E * Log(X_Data(i%)) * LOG10_E * Log(Y_Data(i%))
SumYsq! = SumYsq! + (LOG10_E * Log(Y_Data(i%))) ^ 2
Next i%
End Select
' so the slope and intercept are:
Slope! = (No_Pts% * SumXY! - SumX! * SumY!) / (No_Pts% * SumXsq! - (SumX! ^ 2))
Intercept! = (SumY! / No_Pts%) - Slope! * (SumX! / No_Pts%)
RSQ! = (No_Pts% * SumXY! - SumX! * SumY!) ^ 2 / ((No_Pts% * SumXsq! - (SumX! ^ 2)) * (No_Pts% * SumYsq! - (SumY! ^ 2)))
BestFit_FINISHED:
Exit Sub
BestFit_ErrorHandler: ' Error handler line label.
Select Case Err
Case 5
Resume Next
Case Else
Msg$ = "Panic in " & "BestFit_ErrorHandler !"
Msg$ = Msg$ & LF & LF & "Error No. " & Str$(Err) & ": " & Error$
Response% = Message(Msg$, MB_OK + MB_ICONEXCLAMATION, "Error !", NO, H_PANIC)
End Select
Resume BestFit_FINISHED
End Sub
}
{------------------------------------------------------------------------------
Function: TSeries.FindHighsLows
Description: This function finds all the Highs (and troughs) in a region
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the ??? Property
Return Value: the number of Highs
Known Issues:
------------------------------------------------------------------------------}
function TSeries.FindHighsLows(Start, Finish, HeightSensitivity: Integer): Integer;
var
i,
LastHigh,
LastLow: Integer;
Highseek: Boolean;
Delta: Single;
begin
{this routine finds all the major Highs in a region;
See "FindAHigh" for a single High finding routine.}
{set the sensitivity:}
Delta := (HeightSensitivity / 100.0) * (FYMax - FYMin);
ClearHighsLows;
{initialise variables:}
LastHigh := Start;
LastLow := Start;
Highseek := TRUE;
{allocate memory for results:}
GetMem(FHighs, FHighCapacity * SizeOf(Integer));
GetMem(FLows, FHighCapacity * SizeOf(Integer));
{we set the first point to a low}
Lows^[FLowCount] := LastLow;
Inc(FLowCount);
for i := Start to Finish do
begin
if (Highseek = TRUE) then
begin
if (FYData^[i] > FYData^[LastHigh]) then
LastHigh := i;
if (FYData^[i] < (FYData^[LastHigh] - Delta)) then
begin
{The Last High was a real maximum:}
Highs^[FHighCount] := LastHigh;
Inc(FHighCount);
if (FHighCount >= FHighCapacity-2) then
begin
{add 10 more points:}
{$IFDEF DELPHI1}
ReAllocMem(FHighs, FHighCapacity * SizeOf(Integer),
(FHighCapacity+10) * SizeOf(Integer));
ReAllocMem(FLows, FHighCapacity * SizeOf(Integer),
(FHighCapacity+10) * SizeOf(Integer));
Inc(FHighCapacity, 10);
{$ELSE}
Inc(FHighCapacity, 10);
ReAllocMem(FHighs, FHighCapacity * SizeOf(Integer));
ReAllocMem(FLows, FHighCapacity * SizeOf(Integer));
{$ENDIF}
end;
Highseek := FALSE;
LastLow := i;
end;
end
else
begin
if (FYData^[i] < FYData^[LastLow]) then
LastLow := i;
if (FYData^[i] > (FYData^[LastLow] + Delta)) then
begin
{The Last Low was a real minimum:}
Lows^[FLowCount] := LastLow;
Inc(FLowCount);
Highseek := TRUE;
LastHigh := i;
end; {comparison}
end; {seeking high or low}
end; {for}
Lows^[FLowCount] := LastLow;
FindHighsLows := FHighCount;
end;
end.