home *** CD-ROM | disk | FTP | other *** search
- 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;
- 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 SetSeriesType(Value: TSeriesType);}
- 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; XYFastDrawAt: Integer);
- {This draws the series in XY fashion on the given canvas.}
- 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 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('Series %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.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(
- 'Warning: there are %d points, but you have just added %d text X data values !',
- [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('SetVisible: the X and Y Axis pointers are invalid !' +
- 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: the new Y-Axis Index (%d) must be between 1 and %d !');
-
- 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('Problem with the %s data series !' + CRLF +
- 'Requested No Pts = %d, requested memory = %d bytes',
- [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('Problem with the %s data series !' + CRLF +
- 'Requested No Pts = %d, requested memory = %d bytes',
- [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 +
- ' cannot Assume Mastery from a NIL Series !');
-
- if (OldMaster <> FXDataSeries) then raise
- EComponentError.Create(Self.Name +
- ' cannot Assume Mastery from ' + FXDataSeries.Name +
- ' because ' + FXDataSeries.Name + ' is NOT its X Data Master !');
-
- if (XPts <> FNoPts) then raise
- EComponentError.CreateFmt(Self.Name +
- ' (%d points) cannot Assume a Master (X) Series with %d points !',
- [FNoPts, XPts]);
-
- {this last is probably redundant because of test #2:}
- if (FDependentSeries.Count > 0) then raise
- EComponentError.Create(Self.Name +
- ' cannot Assume a Master (X) Series because it already IS a Master Series !');
-
- 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: ACanvas is nil !');
- {$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: I cannot add data points to the ' + Name + ' series' +
- CRLF + 'because it is externally managed !');
- {$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('AddPoint: I cannot add Y values to the ' + Name +
- ' series because the FXDataSeries is undefined !');
- if (FXDataSeries.NoPts <= FNoPts) then raise
- ERangeError.CreateFmt('AddPoint: the External X data series contains %d points, and I contain %d',
- [FXDataSeries.NoPts, FNoPts]);
- if (FXDataSeries.XData = nil) then raise
- EAccessViolation.Create('AddPoint: I cannot add Y values to the ' + Name +
- ' series because the FXDataSeries X Data pointer is undefined !');
- 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: I cannot add data points to the ' + Name + ' series' +
- CRLF + 'because it is externally managed !');
- {$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('DelPoint: this series (%s) contains %d points, so I cannot delete any !', [FName, FNoPts]);
-
- 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('DelPointNumber: this series (%s) contains %d points, so I cannot delete any !',
- [FName, FNoPts]);
- if ((ThePoint < 0) or (ThePoint >= FNoPts)) then raise
- ERangeError.CreateFmt('DelPointNumber: this series (%s) contains %d points, so I cannot delete point %d !',
- [FName, FNoPts, ThePoint]);
- if (FDependentSeries.Count > 0) then
- begin
- ERangeError.CreateFmt(
- 'I cannot delete any points when %d other series use my X Data !',
- [FDependentSeries.Count]);
- exit;
- end;
-
- if (Confirm) then
- begin
- TheMessage := Format('Delete Point %d: (%e.3, %e.3) ?',
- [ThePoint, FXData^[ThePoint], FYData^[ThePoint]]);
- if (mrNo = MessageDlg(
- {$IFDEF LINUX}
- 'Delete Point',
- {$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: bad input data (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) does not exist !',
- [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('Smooth: the Smoothing Order %d must be in the range: 2...20',
- [SmoothOrder]);
-
- if (FNoPts <= SmoothOrder+1) then raise
- ERangeError.CreateFmt('Smooth: the Smoothing Order (%d) must be less than the number of points (%d) !',
- [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('GetPoint: the Point number d is not within the valid range of %0..%d',
- [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('GetXYPoint: the Point number %d is not within the valid range of %0..%d',
- [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);
-
- with DisplacementForm do
- begin
- SeriesLabel.Caption := FName;
- DeltaXNEdit.AsInteger := FDeltaX;
- DeltaYNEdit.AsInteger := FDeltaY;
-
- DisplacementForm.HelpFile := TheHelpFile;
-
- if (ShowModal = mrOK) then
- ApplyDisplacementChange(DisplacementForm);
- end;
- 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
- 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;
-
- with DataEditor do
- begin
- Caption := 'Data Editor - ' + Self.Name;
- {StatusBar1.SimpleText := Format('%d points', [FNoPts]);}
- ZDataNEdit.AsReal := ZData;
- DataStringGrid.RowCount := FNoPts + 1;
- for i := 0 to FNoPts - 1 do
- begin
- DataStringGrid.Cells[0, i+1] := IntToStr(i);
- DataStringGrid.Cells[1, i+1] := FloatToStr(FXData^[i]);
- DataStringGrid.Cells[2, i+1] := FloatToStr(FYData^[i]);
- end;
- if (XStringData <> nil) then
- begin
- for i := 0 to XStringData.Count-1 do
- DataStringGrid.Cells[3, i+1] := XStringData.Strings[i];
- end;
-
- if (ShowModal = mrOK) then
- ApplyDataChange(DataEditor);
- end; {with}
- 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;
-
- with PointEditorForm do
- begin
- Init(FXData, FYData, FXStringData, FXAxis, FYAxis);
- PointSlideBar.Max := FNoPts-1;
- PointSlideBar.Frequency := Round(FNoPts/10);
- PointSlideBar.PageSize := PointSlideBar.Frequency;
-
- {$IFDEF BCB}
- PointUpDown.Max := FNoPts-1;
- PointNEdit.Max := FNoPts-1;
- {$ELSE}
- {$IFDEF MSWINDOWS}
- PointSpinEdit.MaxValue := FNoPts-1;
- {$ENDIF}
- {$IFDEF LINUX}
- PointSpinEdit.Max := FNoPts-1;
- {$ENDIF}
- {$ENDIF}
- PointSlideBar.Position := ThePointNumber;
- FillData(ThePointNumber);
- DetailsLabel.Caption := FName;
-
- if (FExternalXSeries) then
- begin
- XDataNEdit.Enabled := FALSE;
- XScreenNEdit.Enabled := FALSE;
- end;
-
- PointEditorForm.HelpFile := TheHelpFile;
-
- TheResult := ShowModal;
- ApplyPointChange(PointEditorForm, TheResult);
- end;
- 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('GetPoint: the Point number %d is not within the valid range of %0..%d',
- [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: cannot Compress %s (%d points) by a Ratio of %d !',
- [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: cannot contract %s (%d points) from %d to %d !',
- [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('Failed attempt to find point closest to X = %g'
- + CRLF + 'X Low/Est/High = %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;
-
- function GetAngle: Single;
- begin
- if (Yi = 0) then
- begin
- if (Xi > 0) then
- Result := PI_ON_TWO
- else
- Result := THREE_PI_ON_TWO;
- end
- else
- begin
- if (Xi > 0) then
- begin
- if (Yi < 0) then {top-right quadrant}
- Result := ArcTan(-Xi/Yi)
- else {bottom-right}
- Result := Pi - ArcTan(Xi/Yi);
- end
- else
- begin {X < 0}
- if (Yi > 0) then {bottom-left}
- Result := Pi + ArcTan(-Xi/Yi)
- else {top-left}
- Result := TWO_PI - ArcTan(Xi/Yi);
- end;
- end;
- end;
-
- 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;
- 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: caution with all the PERFORMANCE stuff
- ------------------------------------------------------------------------------}
- procedure TSeries.Draw(ACanvas: TCanvas; XYFastDrawAt: Integer);
- var
- i: Integer; {, j, Index,}
- iX, iXOld, iY, iYMin, iYMax: Integer; {iSpan}
- TheYMin, TheYMax: Single;
- {$IFDEF PERFORMANCE}
- FStartTime: Int64; {TLargeInteger;}
- FFinishTime: Int64;
- FFrequency: Int64;
- ElapsedTime: Double;
- {$ENDIF}
- {$IFDEF POINTERS}
- pX, pY: pSingle;
- {$ENDIF}
- begin
- {$IFDEF PERFORMANCE}
- QueryPerformanceFrequency(FFrequency); {counts per second}
- {get the starting time:}
- QueryPerformanceCounter(FStartTime); { LARGE_INTEGER}
- {$ENDIF}
-
- {As you can see, we did some performance testing here. Guess what ?
- Delphi was FASTER than direct API calls !
-
- On a Dell PII-266 laptop, drawing a normal distribution takes:
- No Pts Time (ms)
- Symbol: None Cross Cross Cross
- API No No Yes Yes
- Pointers No No No Yes
- 100 1.4 4.1 4.5 4.4
- 1000 12 39 43 42
- 10000 123 400 425 417
- 100000 1162 4007 4269 4178
-
- As well, using pointers instead of dynamic arrays gave roughly a 2% speed
- increase - which just isn't worth it.
- }
-
- {$IFDEF DELPHI3_UP}
- Assert(ACanvas <> nil, 'TSeries.Draw: ACanvas is nil !');
- {$ENDIF}
- if ((not FVisible) or
- (FNoPts = 0)) then exit;
-
- ACanvas.Pen.Assign(FPen);
- if (ACanvas.Pen.Width > 0) then
- begin
- if (FNoPts < XYFastDrawAt) then
- begin
- {$IFDEF POINTERS}
- pX := pSingle(FXData);
- pY := pSingle(FYData);
- iX := FXAxis.FofX(pX^)+ FDeltaX;
- iY := FYAxis.FofY(pY^) + FDeltaY;
- {$ELSE}
- iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
- iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
- {$ENDIF}
- {$IFDEF DIRECT_API}
- MoveToEx(ACanvas.Handle, iX, iY, nil);
- {$ELSE}
- ACanvas.MoveTo(iX, iY);
- {$ENDIF}
-
- for i := 1 to FNoPts-1 do
- begin
- {$IFDEF POINTERS}
- Inc(pX);
- Inc(pY);
- iX := FXAxis.FofX(pX^) + FDeltaX;
- iY := FYAxis.FofY(pY^) + FDeltaY;
- {$ELSE}
- iX := FXAxis.FofX(FXData^[i]) + FDeltaX;
- iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
- {$ENDIF}
-
- {$IFDEF DIRECT_API}
- LineTo(ACanvas.Handle, iX, iY);
- {$ELSE}
- ACanvas.LineTo(iX, iY);
- {$ENDIF}
- 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 less accurate but faster algorithm:
- iX := FXAxis.FofX(FXData^[0])+ FDeltaX;
- iY := FYAxis.FofY(FYData^[0]) + FDeltaY;
- ACanvas.MoveTo(iX, iY);
- iSpan := FNoPts div (FXAxis.FofX(FXData^[FNoPts-1])+ FDeltaX-iX);
- Index := 0;
- for i := 1 to (FNoPts div iSpan) do
- begin
- iX := FXAxis.FofX(FXData^[Index])+ FDeltaX;
- TheYMin := FYData^[Index];
- TheYMax := TheYMin;
- for j := 0 to iSpan-1 do
- begin
- if (TheYMin > FYData^[Index]) then
- TheYMin := FYData^[Index];
- if (TheYMax < FYData^[Index]) then
- TheYMax := FYData^[Index];
- Inc(Index);
- end;
- iY := FYAxis.FofY(TheYMin) + FDeltaY;
- iYMax := FYAxis.FofY(TheYMax) + FDeltaY;
- ACanvas.LineTo(iX, iY);
- ACanvas.LineTo(iX, iYMax);
- end;
- if (Index < FNoPts-1) then
- ACanvas.LineTo(FXAxis.FofX(FXData^[FNoPts-1])+ FDeltaX,
- FYAxis.FofY(FYData^[FNoPts-1]) + FDeltaY);
- }
-
- {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 < XYFastDrawAt}
- end; {Pen.Width > 0}
-
- if ((FSymbol <> syNone) and
- (FSymbolSize > 0) and
- (FNoPts < XYFastDrawAt)) then
- begin
- ACanvas.Brush.Assign(FBrush);
- {$IFDEF POINTERS}
- pX := pSingle(FXData);
- pY := pSingle(FYData);
- {$ENDIF}
-
- for i := 0 to FNoPts-1 do
- begin
- {$IFDEF POINTERS}
- iX := FXAxis.FofX(pX^)+ FDeltaX;
- iY := FYAxis.FofY(pY^) + FDeltaY;
- Inc(pX);
- Inc(pY);
- {$ELSE}
- iX := FXAxis.FofX(FXData^[i])+ FDeltaX;
- iY := FYAxis.FofY(FYData^[i]) + FDeltaY;
- {$ENDIF}
- DrawSymbol(ACanvas, iX, iY);
- end; {loop over points}
- end;
-
- if (FHighCount > 0) then
- if (FHighLow <> []) then
- DrawHighs(ACanvas);
-
- {$IFDEF PERFORMANCE}
- {get the finishing time:}
- QueryPerformanceCounter(FFinishTime); { LARGE_INTEGER}
- {take difference and convert to ms:}
- ElapsedTime := 1000 * (FFinishTime - FStartTime) / FFrequency;
- ShowMessage(Format('Drawing series 1 takes %g ms', [ElapsedTime]));
- {$ENDIF}
- 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: ACanvas is nil !');
- {$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: caution with all the PERFORMANCE stuff
- ------------------------------------------------------------------------------}
- 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: ACanvas is nil !');
- {$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: ACanvas is nil !');
- {$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: ACanvas is nil !');
- {$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:
- ------------------------------------------------------------------------------}
- {$IFDEF DIRECT_API}
- Procedure TSeries.DrawSymbol(ACanvas: TCanvas; iX, iY: Integer);
- begin
- case FSymbol of
- syDash:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY, nil);
- LineTo(ACanvas.Handle, iX + FSymbolSize+1, iY);
- end;
- syVertDash:
- begin
- MoveToEx(ACanvas.Handle, iX, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX, iY + FSymbolSize+1);
- end;
- syPlus:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY, nil);
- LineTo(ACanvas.Handle, iX + FSymbolSize+1, iY);
- MoveToEx(ACanvas.Handle, iX, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX, iY + FSymbolSize+1);
- end;
- syCross:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX + FSymbolSize+1, iY + FSymbolSize+1);
- MoveToEx(ACanvas.Handle, iX + FSymbolSize, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX - FSymbolSize-1, iY + FSymbolSize+1);
- end;
- syStar:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY, nil);
- LineTo(ACanvas.Handle, iX + FSymbolSize+1, iY);
- MoveToEx(ACanvas.Handle, iX, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX, iY + FSymbolSize+1);
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX + FSymbolSize+1, iY + FSymbolSize+1);
- MoveToEx(ACanvas.Handle, iX + FSymbolSize, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX - FSymbolSize-1, iY + FSymbolSize+1);
- end;
- sySquare:
- begin
- Rectangle(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize,
- iX + FSymbolSize+1, iY + FSymbolSize+1);
- end;
- syCircle:
- begin
- Ellipse(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize,
- iX + FSymbolSize+1, iY + FSymbolSize+1);
- end;
- syUpTriangle:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY + FSymbolSize+1, nil);
- LineTo(ACanvas.Handle, iX, iY - FSymbolSize);
- LineTo(ACanvas.Handle, iX + FSymbolSize, iY + FSymbolSize+1);
- LineTo(ACanvas.Handle, iX - FSymbolSize, iY + FSymbolSize+1);
- end;
- syDownTriangle:
- begin
- MoveToEx(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize, nil);
- LineTo(ACanvas.Handle, iX, iY + FSymbolSize+1);
- LineTo(ACanvas.Handle, iX + FSymbolSize, iY - FSymbolSize);
- LineTo(ACanvas.Handle, iX - FSymbolSize, iY - FSymbolSize);
- end;
- end;
- MoveToEx(ACanvas.Handle, iX, iY, nil);
- end;
- {$ELSE}
- 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)]);
- {ACanvas.MoveTo(iX - FSymbolSize, iY + FSymbolSize+1);
- ACanvas.LineTo(iX, iY - FSymbolSize);
- ACanvas.LineTo(iX + FSymbolSize, iY + FSymbolSize+1);
- ACanvas.LineTo(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)]);
- {ACanvas.MoveTo(iX - FSymbolSize, iY - FSymbolSize);
- ACanvas.LineTo(iX, iY + FSymbolSize+1);
- ACanvas.LineTo(iX + FSymbolSize, iY - FSymbolSize);
- ACanvas.LineTo(iX - FSymbolSize, iY - FSymbolSize);}
- end;
- end;
- ACanvas.MoveTo(iX, iY);
- end;
- {$ENDIF}
-
- {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.
-