home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 October
/
Chip_2001-10_cd1.bin
/
zkuste
/
delphi
/
kompon
/
d123456
/
CHEMPLOT.ZIP
/
TPlot
/
Datalist.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-07-24
|
136KB
|
4,069 lines
unit Datalist;
{$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: PlotList.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/18/2001
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 TSeriesList sub-component - that manages the data for
ALL Series for TPlot.
Known Issues:
-----------------------------------------------------------------------------}
interface
uses
Classes, SysUtils,
{$IFDEF NO_MATH}NoMath,{$ELSE}Math,{$ENDIF}
{$IFDEF WINDOWS}
Controls, Dialogs, Graphics, Windows,
{$ENDIF}
{$IFDEF WIN32}
Controls, Dialogs, Graphics, Windows,
{$ENDIF}
{$IFDEF LINUX}
Types,
QControls, QDialogs, QGraphics,
{$ENDIF}
{$IFDEF FUNCTIONS}
Parser10, Functons,
{$ENDIF}
Axis, Data, Parser, Plotdefs, Misc, Titles;
type
{TSeriesList is a TList of Series that frees it's items.
Use only descendents of TObject:}
TSeriesList = class(TList)
private
{The AxisList is created and managed in the Plot unit and TCustomPlot component.
The specific axes are:
0 .. X Axis
1 .. Primary Y Axis
2 .. Secondary Y Axis
3 .. Tertiary Y Axis
4 .. etc.}
FAxisList: TList;
FDataChanged: Boolean;
FIgnoreChanges: Boolean;
FXAxis: TAxis;
FYAxis: TAxis;
FOnStyleChange: TNotifyEvent;
FOnDataChange: TNotifyEvent;
LastSavedPoint: Integer;
PlotBorder: TRect;
NoPieRows: Integer;
function GetXmin: Single;
function GetXmax: Single;
function GetYmin: Single;
function GetYmax: Single;
function GetZmin: Single;
function GetZmax: Single;
function GetYErrorMin: Single;
function GetYErrorMax: Single;
function GetMaxNoPts: Integer;
function GetMinNoPts: Integer;
function GetTotalNoPts: Integer;
protected
procedure StyleChange(Sender: TObject);
procedure DataChange(Sender: TObject);
procedure DoStyleChange; virtual;
procedure DoDataChange; virtual;
public
property DataChanged: Boolean read FDataChanged write FDataChanged stored FALSE;
{Has the data any series changed ?}
property IgnoreChanges: Boolean read FIgnoreChanges write FIgnoreChanges;
{Shall we ignore Change and DataChange events ?}
property TotalNoPts: Integer read GetTotalNoPts stored FALSE;
{The total number of points in all series.}
property MaxNoPts: Integer read GetMaxNoPts stored FALSE;
{The number of points in the largest series.}
property MinNoPts: Integer read GetMinNoPts stored FALSE;
{The number of points in the smallest series.}
property Xmin: Single read GetXmin stored FALSE;
{The minimum X value of ALL Series.}
property Xmax: Single read GetXmax stored FALSE;
{The maximum X value of ALL Series.}
property Ymin: Single read GetYmin;
{The minimum Y value of ALL Series connected to the PRIMARY Y Axis.}
property Ymax: Single read GetYmax;
{The maximum Y value of ALL Series connected to the PRIMARY Y Axis.}
property Zmin: Single read GetZmin;
{The minimum Z value of ALL Series.}
property Zmax: Single read GetZmax;
{The maximum Z value of ALL Series.}
property YErrorMin: Single read GetYErrorMin;
{The minimum Y value of ALL Series plus their error.}
property YErrorMax: Single read GetYErrorMax;
{The maximum Y value of ALL Series plus their error.}
property OnStyleChange: TNotifyEvent read FOnStyleChange write FOnStyleChange;
{This notifies the owner (usually TPlot) of a change in style of this series.}
property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
{This notifies the owner (usually TPlot) of a change in the data of this series.}
{}
{NOTE: D1 does not allow published properties for TList descendants.}
Constructor Create(AxisListPtr: TList); virtual;
{Saves the Axes List and initializes LastSavedPoint.}
destructor Destroy; override;
function Add(XSeriesIndex: Integer): Integer;
{This adds a new, empty series to the list.}
{}
{Like its ancestor function, and its relatives AddInternal and AddExternal,
Add returns the index of the new item, where the first item in the list has
an index of 0.}
function AddExternal(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Integer;
{This adds a new, empty series to the list, and sets its data to point to the
external XPointer, YPointer data.}
{}
{Like its ancestor function, and its relatives AddInternal and Add,
AddExternal returns the index of the new item, where the first item in the list has
an index of 0.}
function AddInternal(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Integer;
{This adds a new, empty series to the list, and copies the data from the
XPointer, YPointer data.}
{}
{Like its ancestor function, and its relatives Add and AddExternal,
AddInternal returns the index of the new item, where the first item in the list has
an index of 0.}
procedure ClearSeries;
{This deletes all Series from the list, freeing the series.}
{}
{Note that the Clear does not exist in the D1-3 version, because TList.Clear
is a static method and cannot be overridden. This is why we created ClearSeries.}
function CloneSeries(TheSeries: Integer): Integer;
{This adds a new, empty series to the list, copies the data and properties from
TheSeries into the new clone, and changes the color and Y Displacement.}
{}
{CloneSeries returns TRUE if successful.}
procedure DeleteSeries(Index: Integer; Ask: Boolean);
{This deletes TheSeries from the list.}
function ParseData(TheData: TStringList; TheHelpFile: String): Boolean;
{This parses imported or pasted data and adds it to the SeriesList.}
function ConvertTextData(ColCount, SeriesCount, FirstLine: Integer;
Delimiter: String; TheData: TStringList; SeriesInfo: pSeriesInfoArray): Boolean;
{This takes a parsed stringlist converts it to numerical data.}
function ConvertXYZData(FirstLine: Integer;
Delimiter: String; InfoGridRows: TStrings; TheData: TStringList): Boolean;
{This takes an UNparsed stringlist with XYZ values and converts it to numerical data.}
function ConvertBinaryData(ColCount, SeriesCount: Integer;
TheStream: TMemoryStream; SeriesInfo: pSeriesInfoArray): Boolean;
{This takes a parsed stringlist converts it to numerical data.}
{$IFDEF FUNCTIONS}
function FunctionSeries: Integer;
{This creates a new series which is a function of the existing series.}
{$ENDIF}
procedure DataAsHTMLTable(var TheData: TStringList);
{This returns all the data in HTML format as a StringList.}
procedure GetStream(AsText: Boolean; Delimiter: Char; var TheStream: TMemoryStream);
{This returns all the data as a MemoryStream.}
procedure GetSubHeaderStream(Delimiter: Char; TheStream: TMemoryStream);
{This returns all the SubHeader data as a MemoryStream.}
procedure GetBinaryStream(Start, Finish: Integer;
TheStream: TMemoryStream);
procedure GetTextStream(Delimiter: Char; Start, Finish: Integer;
TheStream: TMemoryStream);
procedure AppendStream(AsText: Boolean; Delimiter: Char; TheStream: TMemoryStreamEx);
{This returns the data collected since LastSavedPoint as a MemoryStream.}
function LoadFromStream(AStream: TMemoryStream; var AsText: Boolean): Boolean;
{Opens data, parses it, fires the OnHeader event, and runs ConvertTextData,
or decides to run it through ParseData instead}
procedure Draw(ACanvas: TCanvas; XYFastAt: Integer);
{This draws all the series on the given canvas.}
procedure DrawError(ACanvas: TCanvas);
{Extended Drawing procedure for series with errorbars.}
procedure DrawBubble(ACanvas: TCanvas; BubbleSize: Integer);
{Extended Drawing procedure for Bubble plots.}
procedure DrawMultiple(ACanvas: TCanvas;
Multiplicity: Byte;
MultiplePen: TPen;
MultiJoin1, MultiJoin2: Integer);
{Extended Drawing procedure for linking multiple series.}
procedure DrawColumns(ACanvas: TCanvas; ColumnGap: TPercent);
{This draws all the series on the given canvas in columns.}
procedure DrawStack(ACanvas: TCanvas; ColumnGap: TPercent);
{This draws all the series on the given canvas in stacked (summed) columns.}
procedure DrawNormStack(ACanvas: TCanvas; ColumnGap: TPercent);
{This draws all the series on the given canvas in normalized columns.}
procedure DrawPie(ACanvas: TCanvas; Border: TBorder; NoRows: Integer);
{This draws all the series on the given canvas as Pie graphs.}
procedure DrawPolar(ACanvas: TCanvas; PolarRange: Single);
{This draws all the series on the given canvas as a Polar graph.}
procedure Draw3DWire(ACanvas: TCanvas; ZAxis: TAngleAxis; ZLink: Boolean);
{This draws all the series on the given canvas as a 3D WireFrame.}
procedure Draw3DColumn(ACanvas: TCanvas; ZAxis: TAngleAxis; ColumnGap: TPercent);
{This draws all the series on the given canvas as a 3D Columns.}
procedure Draw3DContour(ACanvas: TCanvas; ZAxis: TAngleAxis; ContourDetail: TContourDetail; ContourWires: Boolean);
{This draws all the series on the given canvas.}
procedure DrawContour(ACanvas: TCanvas; ContourDetail: TContourDetail);
{This draws all the series on the given canvas as a solid colour contour map.}
procedure DrawLineContour(ACanvas: TCanvas;
ContourStart, ContourInterval: Single;
ContourDetail: TContourDetail);
{This draws all the series on the given canvas as a line contour map.}
procedure DrawColorScale(ACanvas: TCanvas; TheMin, Span: Single; TheContourDetail: TContourDetail);
procedure SortTriangleVertices(var Pt1, Pt2, Pt3: T3DZPoint; var p1, p2, p3: p3DZPoint);
procedure SortTriangleVerticesOnY(var Pt1, Pt2, Pt3: T3DRealPoint; var p1, p2, p3: p3DRealPoint);
procedure DrawHistory(ACanvas: TCanvas; HistoryX: Single);
{This draws all the series on the given canvas, in a History mode.}
procedure DrawHistoryMultiple(ACanvas: TCanvas; Multiplicity: Byte);
{Extended Drawing procedure for linking multiple series in History mode.}
function GetNearestPoint(
ThePlotType: TPlotType;
ColumnGap,
iX, iY: Integer;
var TheSeries: Integer;
var MinDistance: Single;
var pSeries: TSeries): Integer;
{This returns the Index of the nearest point, and sets TheSeries it belongs to}
{published}
function GetSeriesOfZ(ZValue: Single): TSeries;
end;
implementation
uses
Plot;
const
PIE_SIZE = 0.8;
{TSeriesList Constructor and Destructor:---------------------------------------}
{------------------------------------------------------------------------------
Constructor: TSeriesList.Create
Description: standard Constructor
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: saves the Axes List and initializes LastSavedPoint
Known Issues:
------------------------------------------------------------------------------}
Constructor TSeriesList.Create(AxisListPtr: TList);
begin
inherited Create;
FAxisList := AxisListPtr;
FXAxis := TAxis(FAxisList[0]);
FYAxis := TAxis(FAxisList[1]);
LastSavedPoint := 0;
end;
{------------------------------------------------------------------------------
Destructor: TSeriesList.Destroy
Description: standard Destructor
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Frees the Axes and events
Known Issues:
------------------------------------------------------------------------------}
destructor TSeriesList.Destroy;
begin
FOnStyleChange := nil;
FOnDataChange := nil;
{NOTE: in D1-D3, Clear is static and cannot be overridden, so we had to
add a ClearSeries for them:}
ClearSeries;
inherited Destroy;
end;
{TSeriesList Set procedures ---------------------------------------------------}
{TSeriesList Get functions ----------------------------------------------------}
{------------------------------------------------------------------------------
Function: TSeriesList.GetXmin
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the XMin Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetXmin: Single;
var
i: Integer;
Value: Single;
begin
Value := 1.e38;
for i := 0 to Count-1 do
begin
if (Value > TSeries(Items[i]).XMin) then
Value := TSeries(Items[i]).XMin;
end; {loop over series}
GetXmin := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetXMax
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the XMax Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetXmax: Single;
var
i: Integer;
Value: Single;
begin
Value := -1.e38;
for i := 0 to Count-1 do
begin
if (Value < TSeries(Items[i]).XMax) then
Value := TSeries(Items[i]).XMax;
end; {loop over series}
GetXmax := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetYMin
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the YMin Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetYMin: Single;
var
i: Integer;
Value: Single;
begin
Value := 1.e38;
for i := 0 to Count-1 do
begin
if (Value > TSeries(Items[i]).YMin) then
Value := TSeries(Items[i]).YMin;
end; {loop over series}
GetYMin := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetYMax
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the YMax Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetYMax: Single;
var
i: Integer;
Value: Single;
begin
Value := -1.e38;
for i := 0 to Count-1 do
begin
if (Value < TSeries(Items[i]).YMax) then
Value := TSeries(Items[i]).YMax;
end; {loop over series}
GetYMax := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetZMin
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the ZMin Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetZMin: Single;
var
i: Integer;
Value: Single;
begin
Value := 1.e38;
for i := 0 to Count-1 do
begin
if (Value > TSeries(Items[i]).ZData) then
Value := TSeries(Items[i]).ZData;
end; {loop over series}
GetZMin := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetZMax
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the ZMax Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetZMax: Single;
var
i: Integer;
Value: Single;
begin
Value := -1.e38;
for i := 0 to Count-1 do
begin
if (Value < TSeries(Items[i]).ZData) then
Value := TSeries(Items[i]).ZData;
end; {loop over series}
GetZMax := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetYErrorMin
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the YErrorMin Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetYErrorMin: Single;
var
i,
iSeries: Integer;
NewValue,
Value: Single;
pSeries,
pErrorSeries: TSeries;
begin
Value := 1.e38;
iSeries := 0;
while (iSeries <= Self.Count-2) do
begin
pSeries := TSeries(Items[iSeries]);
pErrorSeries := TSeries(Items[iSeries+1]);
for i := 0 to Min(pSeries.NoPts, pErrorSeries.NoPts)-1 do
begin
NewValue := pSeries.YData^[i] - pErrorSeries.YData^[i];
if (Value > NewValue) then
Value := NewValue;
end;
Inc(iSeries, 2)
end; {loop over series}
GetYErrorMin := Value;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetYErrorMax
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the YErrorMax Property over ALL Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetYErrorMax: Single;
var
i,
iSeries: Integer;
NewValue,
Value: Single;
pSeries,
pErrorSeries: TSeries;
begin
Value := 1.e-38;
iSeries := 0;
while (iSeries <= Self.Count-2) do
begin
pSeries := TSeries(Items[iSeries]);
pErrorSeries := TSeries(Items[iSeries+1]);
for i := 0 to Min(pSeries.NoPts, pErrorSeries.NoPts)-1 do
begin
NewValue := pSeries.YData^[i] + pErrorSeries.YData^[i];
if (Value < NewValue) then
Value := NewValue;
end;
Inc(iSeries, 2)
end; {loop over series}
GetYErrorMax := Value;
end;
{TSeriesList Memory and list management ---------------------------------------}
{------------------------------------------------------------------------------
Function: TSeriesList.Add
Description: Adds a new Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: creates, initializes and adds a new series
Return Value: the Index of the new Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.Add(XSeriesIndex: Integer): Integer;
var
Item,
XSeries: TSeries;
begin
if (XSeriesIndex > Count-1) then raise
EComponentError.Create('TSeriesList.Add: ' + sAdd1);
if (XSeriesIndex >= 0) then
XSeries := TSeries(Items[XSeriesIndex])
else
XSeries := nil;
Item := TSeries.Create(Count, FAxisList, XSeries);
Item.OnStyleChange := Self.StyleChange;
Item.OnDataChange := Self.DataChange;
Add := inherited Add(Item);
DoDataChange;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.AddExternal
Description: Adds a new Series that is externally maintained
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 01/25/2001 by Mat Ballard
Purpose: creates, initializes and adds a new series
Return Value: the Index of the new Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.AddExternal(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Integer;
var
Item: TSeries;
begin
{set to failure in case Item.AddData fails:}
AddExternal := -1;
Item := TSeries.Create(Count, FAxisList, nil);
Item.OnDataChange := Self.DataChange;
if (Item.PointToData(XPointer, YPointer, NumberOfPoints)) then
begin
{Success:}
AddExternal := inherited Add(Item);
end
else
begin
{Failure:}
Item.Free;
end;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.AddInternal
Description: Adds a new Series from external data (copies)
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 01/25/2001 by Mat Ballard
Purpose: creates, initializes and adds a new series
Return Value: the Index of the new Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.AddInternal(XPointer, YPointer: pSingleArray; NumberOfPoints: Integer): Integer;
var
Item: TSeries;
begin
{set to failure in case Item.AddData fails:}
AddInternal := -1;
Item := TSeries.Create(Count, FAxisList, nil);
Item.OnDataChange := Self.DataChange;
if (Item.AddData(XPointer, YPointer, NumberOfPoints)) then
begin
{Success:}
AddInternal := inherited Add(Item);
end
else
begin
{Failure:}
Item.Free;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.ClearSeries
Description: frees and deletes all the Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Series management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.ClearSeries;
var
i: Integer;
pSeries: TSeries;
begin
if (Count = 0) then exit;
for i := Count-1 downto 0 do
begin
pSeries := TSeries(Items[i]);
Delete(i);
pSeries.Free;
end;
DoDataChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DeleteSeries
Description: frees and deletes one particular Series
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: Series management
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DeleteSeries(Index: Integer; Ask: Boolean);
var
pSeries: TSeries;
begin
pSeries := TSeries(Items[Index]);
if (Ask) then
Ask := not (MessageDlg(
{$IFDEF LINUX}
sDelete + ' ' + sSeries,
{$ENDIF}
sReallyDelete + ' ' + pSeries.Name + ' ?',
mtWarning, [mbYes,mbNo], 0) = mrYes);
if (not Ask) then
begin
Delete(Index);
pSeries.Free;
DoDataChange;
end;
end;
{$IFDEF FUNCTIONS}
{------------------------------------------------------------------------------
Procedure: TSeriesList.FunctionSeries
Description: Creates a new series which is a function of existing series
Author: Mat Ballard
Date created: 04/03/2001
Date modified: 04/03/2001 by Mat Ballard
Purpose: data manipulation
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.FunctionSeries: Integer;
{This creates a new series which is a function of the existing series.}
var
i, j,
TheResult: Integer;
FunctionsForm: TFunctionsForm;
TheParser: TParser;
TheExpression: String;
TheData: array [0..99] of PParserFloat;
begin
TheResult := -1;
if (Self.Count > 0) then
begin
FunctionsForm := TFunctionsForm.Create(nil);
for i := 0 to Self.Count-2 do
FunctionsForm.FunctionMemo.Lines.Add(Format(sSeries + '%d', [i]) + ' + ');
FunctionsForm.FunctionMemo.Lines.Add(Format(sSeries + '%d', [Self.Count-1]));
FunctionsForm.SeriesLabel.Caption := Format(sSeries + '%d :=', [Self.Count]);
FunctionsForm.SeriesCount := Self.Count;
if (mrOK = FunctionsForm.ShowModal) then
begin
TheResult := Self.Add(0);
TheParser := TParser.Create(nil);
TheExpression := '';
{read the equation:}
for i := 0 to FunctionsForm.FunctionMemo.Lines.Count-1 do
TheExpression := TheExpression + FunctionsForm.FunctionMemo.Lines[i];
TheExpression := Misc.CleanString(TheExpression, ' ');
{try to run the Parser:}
try
{Set up the variables:}
for j := 0 to Self.Count-2 do
TheData[j] := TheParser.SetVariable(Format(UpperCase(sSeries) + '%d', [j]), 0);
{Set up equation:}
TheParser.Expression := TheExpression;
{Loop over all points in Series[0]:}
for i := 0 to TSeries(Self.Items[0]).NoPts-1 do
begin
{add the Series variables to the Parser, or reset their values:}
for j := 0 to Self.Count-2 do
TheData[j]^ := TSeries(Self.Items[j]).YData^[i];
TSeries(Self.Items[TheResult]).AddPoint(-1, TheParser.Value, FALSE, TRUE);
end;
except
Self.DeleteSeries(TheResult, FALSE);
TheResult := -1;
end;
TheParser.Free;
end;
FunctionsForm.Free;
end;
FunctionSeries := TheResult;
end;
{$ENDIF}
{TSeriesList the movie ! ------------------------------------------------------}
{------------------------------------------------------------------------------
Procedure: TSeriesList.Draw
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: draws all the Series on a given canvas
Known Issues: where do we put the drawing and the "GetNearestPoint" methods ?
ptXY needs FXAxis, FYAxis - done in Data
ptError needs FXAxis, FYAxis, AND Index - done in Datalist
ptMultiple needs FXAxis, FYAxis - done in Data
ptColumn needs ColumnGap, Index, FXAxis, FYAxis - done in Datalist
ptStack needs ALL Series, ColumnGap, Index, FXAxis, FYAxis - done in Datalist
ptNormStack needs ALL Series, ColumnGap, Index, FXAxis, FYAxis - done in Datalist
ptPie needs bounding rectangle - done in Data
ptPolar unknown as yet
pt3D needs ALL Series, FXAxis, FYAxis, AND FZAxis - done in Serlist
There seems to be no simple solution to this: some methods have to be, or
are best in this unit; others, according to the principles:
a. bury as deep as possible;
b. each series _SHOULD_ know how to draw itself;
would seem better to be in Data.
------------------------------------------------------------------------------}
procedure TSeriesList.Draw(ACanvas: TCanvas; XYFastAt: Integer);
var
i: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.Draw: ' + sACanvasIsNil);
{$ENDIF}
for i := 0 to Count-1 do
begin
if (TSeries(Items[i]).ShadeLimits) then
TSeries(Items[i]).DrawShades(ACanvas, XYFastAt);
end; {loop over series}
for i := 0 to Count-1 do
begin
TSeries(Items[i]).Draw(ACanvas, XYFastAt);
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawColumns
Description: standard Drawing procedure for Columns
Author: Mat Ballard
Date created: 09/25/2000
Date modified: 09/25/2000 by Mat Ballard
Purpose: draws all the Series on a given canvas in Columns
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawColumns(ACanvas: TCanvas; ColumnGap: TPercent);
var
i,
j,
iX,
iXp1, {iX plus 1: the next X ordinate;}
iXStart,
iXEnd,
iY: Integer;
dX: Single;
pSeries,
pSeries0: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawColumns: ' + sACanvasIsNil);
{$ENDIF}
if (Count = 0) then
exit;
{all columns are plotted against the X Axis and Data of the first series,
otherwise chaos can result.}
pSeries0 := TSeries(Items[0]);
{loop over every series:}
for i := 0 to Count-1 do
begin
pSeries := TSeries(Items[i]);
ACanvas.Pen.Assign(pSeries.Pen);
ACanvas.Brush.Assign(pSeries.Brush);
if ((pSeries.NoPts > 0) and
(pSeries.Visible)) then
begin
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[0]);
{loop over every point in each series:}
for j := 0 to pSeries.NoPts-2 do
begin
iX := iXp1;
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[j+1]);
dX := (iXp1-iX) * ((100 - ColumnGap) / (100 * Count));
iXStart := iX + Round(i*dX);
iXEnd := iXStart + Round(dX);
iY := pSeries.YAxis.FofY(pSeries.YData^[j]);
ACanvas.Rectangle(iXStart, iY, iXEnd, pSeries.YAxis.Bottom);
end; {for}
end; {NoPts > 0}
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawStack
Description: standard Drawing procedure for Stacked Columns
Author: Mat Ballard
Date created: 09/25/2000
Date modified: 09/25/2000 by Mat Ballard
Purpose: draws all the Series on a given canvas in Stacked Columns
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawStack(ACanvas: TCanvas; ColumnGap: TPercent);
var
i,
j,
iX,
iXp1, {iX plus 1: the next X ordinate;}
iXEnd,
iY,
iYNeg,
iYTop,
iYNegBottom: Integer;
NegSum, Sum: Single;
pSeries0: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawColumns: ' + sACanvasIsNil);
{$ENDIF}
if (Count = 0) then
exit;
{all columns are plotted against the X and Y Axis and X Data of the first series,
otherwise chaos can result.}
pSeries0 := TSeries(Items[0]);
if (pSeries0.NoPts = 0) then exit;
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[0]);
{loop over every point:}
for j := 0 to pSeries0.NoPts-2 do
begin
iX := iXp1;
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[j+1]);
iXEnd := iXp1 - Round((ColumnGap) * (iXp1-iX) / 100);
iYTop := pSeries0.XAxis.MidY;
iYNegBottom := iYTop;
Sum := 0;
NegSum := 0;
{loop over every series:}
for i := 0 to Self.Count-1 do
begin
if ((TSeries(Items[i]).NoPts > j) and
(TSeries(Items[i]).Visible)) then
begin
ACanvas.Pen.Assign(TSeries(Items[i]).Pen);
ACanvas.Brush.Assign(TSeries(Items[i]).Brush);
if (TSeries(Items[i]).YData^[j] >= 0) then
begin
Sum := Sum + TSeries(Items[i]).YData^[j];
iY := iYTop;
iYTop := pSeries0.YAxis.FofY(Sum);
ACanvas.Rectangle(iX, iY, iXEnd, iYTop);
end
else
begin
NegSum := NegSum + TSeries(Items[i]).YData^[j];
iYNeg := iYNegBottom;
iYNegBottom := pSeries0.YAxis.FofY(NegSum);
ACanvas.Rectangle(iX, iYNeg, iXEnd, iYNegBottom);
end;
end; {for}
end; {NoPts > 0}
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawNormStack
Description: standard Drawing procedure for Normalized Stacked Columns
Author: Mat Ballard
Date created: 09/25/2000
Date modified: 09/25/2000 by Mat Ballard
Purpose: draws all the Series on a given canvas in Normalized (percentage) Stacked Columns
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawNormStack(ACanvas: TCanvas; ColumnGap: TPercent);
var
i,
j,
iX,
iXp1, {iX plus 1: the next X ordinate;}
iXEnd,
iY,
iYNeg,
iYTop,
iYNegBottom: Integer;
Sum, NegSum,
Total, NegTotal: Single;
pSeries0: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawColumns: ' + sACanvasIsNil);
{$ENDIF}
if (Count = 0) then
exit;
{all columns are plotted against the X and Y Axis and X Data of the first series,
otherwise chaos can result.}
pSeries0 := TSeries(Items[0]);
if (pSeries0.NoPts = 0) then exit;
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[0]);
{loop over every point:}
for j := 0 to pSeries0.NoPts-2 do
begin
iX := iXp1;
iXp1 := pSeries0.XAxis.FofX(pSeries0.XData^[j+1]);
iXEnd := iXp1 - Round((ColumnGap) * (iXp1-iX) / 100);
iYTop := pSeries0.XAxis.MidY;
iYNegBottom := iYTop;
Sum := 0;
NegSum := 0;
Total := 0;
NegTotal := 0;
{count every series:}
for i := 0 to Count-1 do
begin
if (TSeries(Items[i]).NoPts > j) then
begin
if (TSeries(Items[i]).YData^[j] >= 0) then
Total := Total + TSeries(Items[i]).YData^[j]
else
NegTotal := NegTotal + TSeries(Items[i]).YData^[j];
end; {NoPts > j}
end; {count every series}
{prepare for conversion of data to percent:}
Total := Total / 100;
NegTotal := - NegTotal / 100;
{loop over every series:}
for i := 0 to Count-1 do
begin
if (TSeries(Items[i]).NoPts > j) then
begin
ACanvas.Pen.Assign(TSeries(Items[i]).Pen);
ACanvas.Brush.Assign(TSeries(Items[i]).Brush);
if (TSeries(Items[i]).YData^[j] >= 0) then
begin
Sum := Sum + (TSeries(Items[i]).YData^[j] / Total);
iY := iYTop;
iYTop := pSeries0.YAxis.FofY(Sum);
if (TSeries(Items[i]).Visible) then
ACanvas.Rectangle(iX, iY, iXEnd, iYTop);
end
else
begin
NegSum := NegSum + (TSeries(Items[i]).YData^[j] / NegTotal);
iYNeg := iYNegBottom;
iYNegBottom := pSeries0.YAxis.FofY(NegSum);
if (TSeries(Items[i]).Visible) then
ACanvas.Rectangle(iX, iYNeg, iXEnd, iYNegBottom);
end;
end; {for}
end; {NoPts > 0}
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawPie
Description: standard Drawing procedure for Normalized Stacked Columns
Author: Mat Ballard
Date created: 12/20/2000
Date modified: 12/20/2000 by Mat Ballard
Purpose: This draws all the series on the given canvas as Pie graphs.
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawPie(ACanvas: TCanvas; Border: TBorder; NoRows: Integer);
var
CellWidth,
CellHeight,
iSeries,
iCol,
jRow,
NoPieCols,
PieLeft,
PieTop,
PieWidth,
PieHeight: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawPie: ' + sACanvasIsNil);
{$ENDIF}
if ((Count = 0) or (NoRows = 0)) then
exit;
{remember the number of rows:}
NoPieRows := NoRows;
NoPieCols := Trunc(0.99 + Self.Count / NoPieRows);
{remember the border:}
PlotBorder.Left := Border.Left;
PlotBorder.Top := Border.Top;
PlotBorder.Right := Border.Right;
PlotBorder.Bottom := Border.Bottom;
{each Pie sits in a cell:}
CellWidth := (PlotBorder.Right - PlotBorder.Left) div NoPieCols;
CellHeight := (PlotBorder.Bottom - PlotBorder.Top) div NoPieRows;
{... but does not occupy the entire cell:}
PieWidth := Round(PIE_SIZE * CellWidth);
PieHeight := Round(PIE_SIZE * CellHeight);
if (PieHeight > PieWidth) then
PieHeight := PieWidth;
iSeries := 0;
for iCol := 0 to NoPieCols-1 do
begin
for jRow := 0 to NoPieRows-1 do
begin
if (iSeries >= Count) then break;
{indent the (left, top) a bit:}
PieLeft := PlotBorder.Left + iCol * CellWidth +
(CellWidth-PieWidth) div 2;
PieTop := PlotBorder.Top + jRow * CellHeight +
(CellHeight-PieHeight) div 2;
{draw it:}
TSeries(Self.Items[iSeries]).DrawPie(
ACanvas,
PieLeft,
PieTop,
PieWidth,
PieHeight);
Inc(iSeries);
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawPolar
Description: standard Drawing procedure for Normalized Stacked Columns
Author: Mat Ballard
Date created: 12/20/2000
Date modified: 12/20/2000 by Mat Ballard
Purpose: This draws all the series on the given canvas as a Polar graph.
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawPolar(ACanvas: TCanvas; PolarRange: Single);
var
i: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.Draw: ' + sACanvasIsNil);
{$ENDIF}
if (PolarRange = 0) then
PolarRange := TWO_PI;
for i := 0 to Self.Count-1 do
begin
TSeries(Items[i]).DrawPolar(ACanvas, PolarRange);
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.Draw3DWire
Description: standard Drawing procedure for 3D graphs
Author: Mat Ballard
Date created: 01/24/2001
Date modified: 01/24/2001 by Mat Ballard
Purpose: This draws all the series as a 3D graph
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.Draw3DWire(ACanvas: TCanvas; ZAxis: TAngleAxis; ZLink: Boolean);
var
iSeries,
j: Integer;
Pt00, Pt01, Pt10, Pt11: TPoint;
{These correspond to Point[Series #, Point #]}
ZShift0,
ZShift1: TPoint;
pSeries0,
pSeries1: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.Draw3DWire: ' + sACanvasIsNil);
Assert(ZAxis <> nil, 'TSeriesList.Draw3DWire: ' + sDraw3D);
{$ENDIF}
{Draw each individual series:}
for iSeries := 0 to Self.Count-1 do
begin
ACanvas.Pen.Assign(TSeries(Items[iSeries]).Pen);
pSeries0 := TSeries(Items[iSeries]);
Pt10.x := Low(Integer);
if (pSeries0.NoPts > 0) then
begin
ZShift0 := ZAxis.dFofZ(pSeries0.ZData);
Pt00.x := pSeries0.XAxis.FofX(pSeries0.XData^[0])+ ZShift0.x;
Pt00.y := pSeries0.YAxis.FofY(pSeries0.YData^[0]) + ZShift0.y;
if ((ZLink) and (iSeries < Count-1)) then
begin
pSeries1 := TSeries(Items[iSeries+1]);
if (pSeries1.NoPts > 0) then
begin
ZShift1 := ZAxis.dFofZ(pSeries1.ZData);
Pt10.x := pSeries1.XAxis.FofX(pSeries1.XData^[0])+ ZShift1.x;
Pt10.y := pSeries1.YAxis.FofY(pSeries1.YData^[0]) + ZShift1.y;
end;
end;
for j := 1 to pSeries0.NoPts-1 do
begin
Pt01.x := pSeries0.XAxis.FofX(pSeries0.XData^[j]) + ZShift0.x;
Pt01.y := pSeries0.YAxis.FofY(pSeries0.YData^[j]) + ZShift0.y;
ACanvas.MoveTo(Pt00.x, Pt00.y);
ACanvas.LineTo(Pt01.x, Pt01.y);
if ((ZLink) and (iSeries < Count-1)) then
begin
{Oh yes it was: Delphi isn't smart enough to see that if we got here,
then it WAS initialized. Same applies to Pt10.x, Pt10.y.}
if (pSeries1.NoPts > 0) then
begin
Pt11.x := pSeries1.XAxis.FofX(pSeries1.XData^[j]) + ZShift1.x;
Pt11.y := pSeries1.YAxis.FofY(pSeries1.YData^[j]) + ZShift1.y;
ACanvas.MoveTo(Pt10.x, Pt10.y);
ACanvas.LineTo(Pt00.x, Pt00.y);
{no triangles please, we're British:
ACanvas.LineTo(Pt11.x, Pt11.y);}
Pt10.x := Pt11.x;
Pt10.y := Pt11.y;
end;
end; {not the final series}
Pt00.x := Pt01.x;
Pt00.y := Pt01.y;
end; {loop over points}
if (Pt10.x <> Low(Integer)) then
begin
ACanvas.MoveTo(Pt00.x, Pt00.y);
ACanvas.LineTo(Pt10.x, Pt10.y);
end;
end; {NoPts}
end; {over every series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.Draw3DColumn
Description: standard Drawing procedure for 3D graphs
Author: Mat Ballard
Date created: 06/01/2001
Date modified: 06/01/2001 by Mat Ballard
Purpose: This draws all the series on the given canvas as a 3D Columns.
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.Draw3DColumn(ACanvas: TCanvas; ZAxis: TAngleAxis; ColumnGap: TPercent);
var
iSeries,
j: Integer;
iX, iXp1, FofX, Height, dX: Integer;
FofZ, FofZp1, dz: TPoint;
pSeries: TSeries;
{ NB: FofZ and dz are vectors in TPoint format.
y
^
|
|
| FofX
| |
|----------------/------------> x
/ /
/ 4_______/5 ___
/ /. . /| ^
/ / . . / |
/ /_______/ | Height
/ 7 . . 6 |
/ | .. | |
FofZ _/ | 0....|..1 _v___
/ | . | / dz
z 3_______2/_____/
| |
|< dX >| }
procedure DrawCol(FofX, Height, dX: Integer; FofZ, dz: TPoint);
var
Vertex: array[0..7] of TPoint;
begin
{calculate the positions of the six required vertices in the above diagram:}
Vertex[0].x := FofX + FofZ.x;
Vertex[4].x := Vertex[0].x;
Vertex[3].x := Vertex[4].x + dz.x;
Vertex[7].x := Vertex[3].x;
Vertex[2].x := Vertex[3].x + dX;
Vertex[6].x := Vertex[2].x;
Vertex[1].x := Vertex[4].x + dX;
Vertex[5].x := Vertex[1].x;
Vertex[0].y := FYAxis.Bottom + FofZ.y;
Vertex[1].y := Vertex[0].y;
Vertex[2].y := Vertex[1].y + dz.y;
Vertex[3].y := Vertex[2].y;
Vertex[4].y := Vertex[0].y + Height;
Vertex[5].y := Vertex[4].y;
Vertex[6].y := Vertex[2].y + Height;
Vertex[7].y := Vertex[6].y;
{The rectangular front face:}
ACanvas.Rectangle(Vertex[7].x, Vertex[7].y, Vertex[2].x, Vertex[2].y);
{Make it a little darker:}
ACanvas.Brush.Color := GetDarkerColor(ACanvas.Brush.Color, 80);
{Draw the top parallelogram:}
ACanvas.Polygon([Vertex[6], Vertex[7], Vertex[4], Vertex[5]]);
{Make it a little darker again:}
ACanvas.Brush.Color := GetDarkerColor(ACanvas.Brush.Color, 70);
{Draw the right or left parallelogram:}
if (dz.x > 0) then
ACanvas.Polygon([Vertex[0], Vertex[3], Vertex[7], Vertex[4]]) {left}
else
ACanvas.Polygon([Vertex[1], Vertex[2], Vertex[6], Vertex[5]]); {right}
end;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.Draw3DColumn: ' + sACanvasIsNil);
Assert(ZAxis <> nil, 'TSeriesList.Draw3DColumn: ' + sDraw3D);
{$ENDIF}
{Draw each individual series:}
{NB: the ZData values better be in ascending order !}
{set dz in case there is only one series !}
dz := ZAxis.dFofZ(1);
for iSeries := 0 to Self.Count-1 do
begin
pSeries := TSeries(Items[iSeries]);
if ((pSeries.NoPts > 0) and
(pSeries.Visible)) then
begin
ACanvas.Pen.Assign(pSeries.Pen);
ACanvas.Brush.Assign(pSeries.Brush);
{the Z co-ordinates are the same for every point in the series:}
FofZ := ZAxis.dFofZ(pSeries.ZData);
if (iSeries < Self.Count-1) then
begin
FofZp1 := ZAxis.dFofZ(TSeries(Items[iSeries+1]).ZData);
dz.x := (FofZp1.x - FofZ.x) * (100 - ColumnGap) div 100;
dz.y := (FofZp1.y - FofZ.y) * (100 - ColumnGap) div 100;
end;
{the starting X Point is:}
iXp1 := pSeries.XAxis.FofX(pSeries.XData^[0]);
{loop over every point in each series:}
for j := 0 to pSeries.NoPts-2 do
begin
ACanvas.Brush.Color := pSeries.Brush.Color;
iX := iXp1;
iXp1 := pSeries.XAxis.FofX(pSeries.XData^[j+1]);
dX := (iXp1-iX) * (100 - ColumnGap) div 100;
FofX := pSeries.XAxis.FofX(pSeries.XData^[j]);
Height := pSeries.YAxis.FofY(pSeries.YData^[j]) - pSeries.YAxis.Bottom;// FXAxis.MidY;
DrawCol(FofX, Height, dX, FofZ, dz);
end; {for j}
end; {NoPts > 0 & Visible}
end; {for iSeries}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.Draw3DContour
Description: standard Drawing procedure for 3D contour graphs
Author: Mat Ballard
Date created: 03/06/2001
Date modified: 03/06/2001 by Mat Ballard
Purpose: This draws all the series as a 3D contour graph
Known Issues: Minor glitch that results in small "holes" - reason unknown
Comment: Note that the paradigm is Y = F(X, Z).
That is, X and Z are the independent variables, and Y is the function.
Colour is based on Y Values, not Z.
------------------------------------------------------------------------------}
procedure TSeriesList.Draw3DContour(
ACanvas: TCanvas;
ZAxis: TAngleAxis;
ContourDetail: TContourDetail;
ContourWires: Boolean);
var
i, iSeries: Integer;
ZFraction,
TheMin,
Span: Single;
{The original 3D data points:}
Pt00, Pt01, Pt10, Pt11, PtCentre: T3DRealPoint;
{The transformed 2D screen points:}
Q00, Q10, Q11, Q01, QCentre: TPoint;
pSeries0,
pSeries1: TSeries;
{Transform the 3D point to the 2D drawing surface:}
function Trans3D2(APoint: T3DRealPoint): TPoint;
var
ZShift: TPoint;
begin
ZShift := ZAxis.dFofZ(APoint.Z);
Result.x := FXAxis.FofX(APoint.X) + ZShift.x;
Result.y := FYAxis.FofY(APoint.Y) + ZShift.y;
end;
{This procedure performs a simple, single color rendition of a triangle:}
procedure BltTriangle(Q00, Q10, Q11: TPoint; ZValue: Single);
begin
ACanvas.Pen.Color := Misc.Rainbow(ZValue);
ACanvas.Brush.Color := ACanvas.Pen.Color;
ACanvas.Polygon([Q00, Q10, Q11]);
end;
{This procedure performs a complex, three-color graded rendition of a triangle:}
procedure RenderTriangle(Pt1, Pt2, Pt3: T3DRealPoint);
var
ii, nY: Integer;
p1, p2, p3: p3DRealPoint; //Highest, medium, lowest points in Z direction
{Sides of the triangle:}
P1P2, P1P3, P2P3,
{Pj is the left side of the triangle, Pk the right:}
Pj, Pk, PjM1, PkM1: T3DRealPoint; //PjM1 = "P(j - 1)"
dY, dxj, dzj, dxk, dzk: Single;
begin
{sort the bastards first, on _Y_ values:}
SortTriangleVerticesOnY(Pt1, Pt2, Pt3, p1, p2, p3);
{create the line vectors of the sides of the triangle:}
P1P2.X := p2^.X - p1^.X;
P1P2.Y := p2^.Y - p1^.Y;
P1P2.Z := p2^.Z - p1^.Z;
P1P3.X := p3^.X - p1^.X;
P1P3.Y := p3^.Y - p1^.Y;
P1P3.Z := p3^.Z - p1^.Z;
P2P3.X := p3^.X - p2^.X;
P2P3.Y := p3^.Y - p2^.Y;
P2P3.Z := p3^.Z - p2^.Z;
{Get ready to loop: set the Pj and Pk to p1, the highest point:}
Pj.X := p1^.X;
Pj.Y := p1^.Y;
Pj.Z := p1^.Z;
Pk.X := p1^.X;
Pk.Y := p1^.Y;
Pk.Z := p1^.Z;
Q10 := Trans3D2(Pj);
Q11 := Q10;
{Estimate a colour granularity:}
dY := Span / COLOUR_GRANULARITY;
nY := Abs(Round(P1P3.Y / dY));
if (nY < 2) then
nY := 2;
dY := P1P2.Y / nY;
dxj := P1P2.X / nY;
dzj := P1P2.Z / nY;
dxk := P1P3.X * (dY / P1P3.Y);
dzk := P1P3.Z * (dY / P1P3.Y);
for ii := 1 to nY do
begin
{Update last points:}
PjM1.X := Pj.X;
PjM1.Y := Pj.Y;
PjM1.Z := Pj.Z;
PkM1.X := Pk.X;
PkM1.Y := Pk.Y;
PkM1.Z := Pk.Z;
Q00 := Q10;
Q01 := Q11;
{move so that colour changes by dY:}
Pj.Y := Pj.Y + dY;
Pj.X := p1^.X + ii * dxj;
Pj.Z := p1^.Z + ii * dzj;
Pk.Y := Pj.Y;
Pk.X := p1^.X + ii * dxk;
Pk.Z := p1^.Z + ii * dzk;
{Draw:}
ZFraction := (PjM1.Y - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
Q10 := Trans3D2(Pj);
Q11 := Trans3D2(Pk);
if ((Q10.x <> Q00.x) or (Q10.y <> Q00.y) or
(Q11.x <> Q01.x) or (Q11.y <> Q01.y)) then
ACanvas.Polygon([Q00, Q01, Q11, Q10]);
end; {for}
{Estimate a colour granularity:}
dY := Span / COLOUR_GRANULARITY;
nY := Abs(Round(P2P3.Y / dY));
if (nY < 2) then
nY := 2;
dY := P2P3.Y / nY;
dxj := P2P3.X / nY;
dzj := P2P3.Z / nY;
for ii := 1 to nY do
begin
{Update last points:}
PjM1.X := Pj.X;
PjM1.Y := Pj.Y;
PjM1.Z := Pj.Z;
PkM1.X := Pk.X;
PkM1.Y := Pk.Y;
PkM1.Z := Pk.Z;
Q00 := Q10;
Q01 := Q11;
{move so that colour changes by dY:}
Pj.Y := Pj.Y + dY;
Pj.X := p2^.X + ii * dxj;
Pj.Z := p2^.Z + ii * dzj;
{Calculate position of same Z on long right side:}
Pk.Y := Pj.Y;
ZFraction := (Pk.Y-p1^.Y)/(p3^.Y-p1^.Y);
Pk.X := p1^.X + ZFraction * P1P3.X;
Pk.Z := p1^.Z + ZFraction * P1P3.Z;
{Draw:}
ZFraction := (PjM1.Y - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
Q10 := Trans3D2(Pj);
Q11 := Trans3D2(Pk);
if ((Q10.x <> Q00.x) or (Q10.y <> Q00.y) or
(Q11.x <> Q01.x) or (Q11.y <> Q01.y)) then
ACanvas.Polygon([Q00, Q01, Q11, Q10]);
end; {for}
end;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawContour: ' + sACanvasIsNil);
{$ENDIF}
TheMin := Self.Ymin;
Span := Self.YMax - TheMin;
ACanvas.Brush.Style := bsSolid;
{Draw each individual series:}
for iSeries := 0 to Self.Count-1 do
begin
pSeries0 := TSeries(Items[iSeries]);
if (pSeries0.NoPts > 0) then
begin
{Assign the bottom-left point:}
Pt00.X := pSeries0.XData^[0];
Pt00.Y := pSeries0.YData^[0];
Pt00.Z := pSeries0.ZData;
if (iSeries < Count-1) then
begin
pSeries1 := TSeries(Items[iSeries+1]);
if (pSeries1.NoPts > 0) then
begin
{Assign the top-left point:}
Pt10.X := pSeries1.XData^[0];
Pt10.Y := pSeries1.YData^[0];
Pt10.Z := pSeries1.ZData;
end;
end;
for i := 1 to pSeries0.NoPts-1 do
begin
{Assign the bottom-right point:}
Pt01.X := pSeries0.XData^[i];
Pt01.Y := pSeries0.YData^[i];
Pt01.Z := pSeries0.ZData;
{Oh yes it was: Delphi ain't that smart.}
if ((iSeries < Count-1) and (pSeries1.NoPts > 0)) then
begin
{Assign the top-right point:}
Pt11.X := pSeries1.XData^[i];
Pt11.Y := pSeries1.YData^[i];
Pt11.Z := pSeries1.ZData;
{Calculate the centrum:}
PtCentre.X := (Pt00.X + Pt01.X + Pt10.X + Pt11.X) / 4;
PtCentre.Y := (Pt00.Y + Pt01.Y + Pt10.Y + Pt11.Y) / 4;
{Oh yes it was: see above}
PtCentre.Z := (Pt00.Z + Pt01.Z + Pt10.Z + Pt11.Z) / 4;
{just how detailed will the plot be ?}
case ContourDetail of
cdLow:
begin
{No triangles; base colour on the Y Value:}
ZFraction := (PtCentre.Y - TheMin) / Span;
ACanvas.Brush.Color := Misc.Rainbow(ZFraction);
if (ContourWires) then
ACanvas.Pen.Color := clBlack
else
ACanvas.Pen.Color := ACanvas.Brush.Color;
ACanvas.Polygon([
Trans3D2(Pt00),
Trans3D2(Pt10),
Trans3D2(Pt11),
Trans3D2(Pt01)]);
end;
cdMedium:
begin
Q00 := Trans3D2(Pt00);
Q10 := Trans3D2(Pt10);
Q11 := Trans3D2(Pt11);
Q01 := Trans3D2(Pt01);
QCentre := Trans3D2(PtCentre);
{Left triangle, then Bottom, Top then Right:}
ZFraction := ((Pt00.Y + Pt10.Y + PtCentre.Y)/3-TheMin) / Span;
BltTriangle(Q00, Q10, QCentre, ZFraction);
ZFraction := ((Pt00.Y + Pt01.Y + PtCentre.Y)/3-TheMin) / Span;
BltTriangle(Q00, Q01, QCentre, ZFraction);
ZFraction := ((Pt10.Y + Pt11.Y + PtCentre.Y)/3-TheMin) / Span;
BltTriangle(Q10, Q11, QCentre, ZFraction);
ZFraction := ((Pt01.Y + Pt11.Y + PtCentre.Y)/3-TheMin) / Span;
BltTriangle(Q01, Q11, QCentre, ZFraction);
if (ContourWires) then
begin
ACanvas.Pen.Color := clBlack;
ACanvas.PolyLine([
Trans3D2(Pt00),
Trans3D2(Pt10),
Trans3D2(Pt11),
Trans3D2(Pt01),
Trans3D2(Pt00)]);
end;
end;
cdHigh:
begin
{Left triangle, then Bottom, Top then Right:}
RenderTriangle(Pt00, Pt10, PtCentre);
RenderTriangle(Pt00, Pt01, PtCentre);
RenderTriangle(Pt10, Pt11, PtCentre);
RenderTriangle(Pt01, Pt11, PtCentre);
if (ContourWires) then
begin
ACanvas.Pen.Color := clBlack;
ACanvas.PolyLine([
Trans3D2(Pt00),
Trans3D2(Pt10),
Trans3D2(Pt11),
Trans3D2(Pt01),
Trans3D2(Pt00)]);
end;
end;
end; {case}
{update values:}
Pt10.x := Pt11.x;
Pt10.y := Pt11.y;
Pt10.Z := Pt11.Z;
end; {not the final series}
Pt00.x := Pt01.x;
Pt00.y := Pt01.y;
Pt00.Z := Pt01.Z;
end; {loop over points}
end; {NoPts}
end; {over every series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawContour
Description: standard Drawing procedure for 2.5D contour graphs
Author: Mat Ballard
Date created: 01/24/2001
Date modified: 07/15/2001 by Mat Ballard
Purpose: This draws all the series as a 2.5D coloured contour graph
Known Issues: Note that Y data is plotted as the color, and the Z data
as screen Y
------------------------------------------------------------------------------}
procedure TSeriesList.DrawContour(
ACanvas: TCanvas; ContourDetail: TContourDetail);
var
i, iSeries: Integer;
ZFraction,
TheMin,
Span: Single;
Pt00, Pt01, Pt10, Pt11, PtCentre: T3DZPoint;
pSeries0,
pSeries1: TSeries;
{This procedure performs a simple, single color rendition of a triangle:}
procedure BltTriangle(Pt1, Pt2, Pt3: T3DZPoint);
begin
ZFraction := ((Pt1.Z + Pt2.Z + Pt3.Z)/3-TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
ACanvas.Polygon([Point(Pt1.x,Pt1.y), Point(Pt2.x,Pt2.y), Point(Pt3.x,Pt3.y)]);
end;
{This procedure performs a complex, three-color graded rendition of a triangle:}
procedure RenderTriangle(Pt1, Pt2, Pt3: T3DZPoint);
var
ii, nZ: Integer;
p1, p2, p3: p3DZPoint; //Highest, medium, lowest points in Z direction
{Sides of the triangle:}
P1P2, P1P3, P2P3,
{Pj is the left side of the triangle, Pk the right:}
Pj, Pk, PjM1, PkM1: T3DZPoint; //PjM1 = "P(j - 1)"
dZ, dxj, dyj, dxk, dyk: Single;
begin
{sort the bastards first, on Z values:}
SortTriangleVertices(Pt1, Pt2, Pt3, p1, p2, p3);
{create the line vectors of the sides of the triangle:}
P1P2.x := p2^.x - p1^.x;
P1P2.y := p2^.y - p1^.y;
P1P2.Z := p2^.Z - p1^.Z;
P1P3.x := p3^.x - p1^.x;
P1P3.y := p3^.y - p1^.y;
P1P3.Z := p3^.Z - p1^.Z;
P2P3.x := p3^.x - p2^.x;
P2P3.y := p3^.y - p2^.y;
P2P3.Z := p3^.Z - p2^.Z;
{Get ready to loop: set the Pj and Pk to p1, the highest point:}
Pj.x := p1^.x;
Pj.y := p1^.y;
Pj.Z := p1^.Z;
Pk.x := p1^.x;
Pk.y := p1^.y;
Pk.Z := p1^.Z;
{Draw the apex:}
//ZFraction := (p1^.Z - TheMin) / Span;
{$IFDEF MSWINDOWS}
//ACanvas.Pixels[p1^.x, p1^.y] := Misc.Rainbow(ZFraction);
{$ENDIF}
{$IFDEF LINUX}
//ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
//ACanvas.DrawPoint(p1^.x, p1^.y);
{$ENDIF}
{Estimate a colour granularity:}
dZ := Span / COLOUR_GRANULARITY;
nZ := Abs(Round(P1P3.Z / dZ));
if (nZ < 2) then
nZ := 2;
dZ := P1P2.Z / nZ;
dxj := P1P2.x / nZ;
dyj := P1P2.y / nZ;
dxk := P1P3.x * (dZ / P1P3.Z);
dyk := P1P3.y * (dZ / P1P3.Z);
for ii := 1 to nZ do
begin
{Update last points:}
PjM1.x := Pj.x;
PjM1.y := Pj.y;
PjM1.Z := Pj.Z;
PkM1.x := Pk.x;
PkM1.y := Pk.y;
PkM1.Z := Pk.Z;
{move so that colour changes by dZ:}
Pj.Z := Pj.Z + dZ;
Pj.x := p1^.x + Round(ii * dxj);
Pj.y := p1^.y + Round(ii * dyj);
Pk.Z := Pj.Z; //Pk.Z + dZ;
Pk.x := p1^.x + Round(ii * dxk);
Pk.y := p1^.y + Round(ii * dyk);
{Draw:}
ZFraction := (PjM1.Z - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
if ((Pj.x <> PjM1.x) or (Pj.y <> PjM1.y) or
(Pk.x <> PkM1.x) or (Pk.y <> PkM1.y)) then
ACanvas.Polygon([
Point(PjM1.x,PjM1.y),
Point(PkM1.x,PkM1.y),
Point(Pk.x,Pk.y),
Point(Pj.x,Pj.y)]);
end; {for}
{Estimate a colour granularity:}
dZ := Span / COLOUR_GRANULARITY;
nZ := Abs(Round(P2P3.Z / dZ));
if (nZ < 2) then
nZ := 2;
dZ := P2P3.Z / nZ;
dxj := P2P3.x / nZ;
dyj := P2P3.y / nZ;
for ii := 1 to nZ do
begin
{Update last points:}
PjM1.x := Pj.x;
PjM1.y := Pj.y;
PjM1.Z := Pj.Z;
PkM1.x := Pk.x;
PkM1.y := Pk.y;
PkM1.Z := Pk.Z;
{move so that colour changes by dZ:}
Pj.Z := Pj.Z + dZ;
Pj.x := p2^.x + Round(ii * dxj);
Pj.y := p2^.y + Round(ii * dyj);
Pk.Z := Pj.Z;
{Calculate position of same Z on long right side:}
ZFraction := (Pk.Z-p1^.Z)/(p3^.Z-p1^.Z);
Pk.x := p1^.x + Round(ZFraction * P1P3.x);
Pk.y := p1^.y + Round(ZFraction * P1P3.y);
{Draw:}
ZFraction := (PjM1.Z - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
if ((Pj.x <> PjM1.x) or (Pj.y <> PjM1.y) or
(Pk.x <> PkM1.x) or (Pk.y <> PkM1.y)) then
ACanvas.Polygon([
Point(PjM1.x,PjM1.y),
Point(PkM1.x,PkM1.y),
Point(Pk.x,Pk.y),
Point(Pj.x,Pj.y)]);
end; {for}
end;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawContour: ' + sACanvasIsNil);
{$ENDIF}
TheMin := Self.Ymin;
Span := Self.YMax - TheMin;
ACanvas.Brush.Style := bsSolid;
{Draw each individual series:}
for iSeries := 0 to Self.Count-1 do
begin
pSeries0 := TSeries(Items[iSeries]);
if (pSeries0.NoPts > 0) then
begin
{Assign the bottom-left point:}
Pt00.x := pSeries0.XAxis.FofX(pSeries0.XData^[0]);
{Note: for contours, we plot the Y data as a function of X and Z,
so that Y determines the color, and Z determines the screen Y value.
The reason for this is that most data will be in the form of scans (series)
at repeated times.}
Pt00.y := pSeries0.YAxis.FofY(pSeries0.ZData);
Pt00.Z := pSeries0.YData^[0];
if (iSeries < Count-1) then
begin
pSeries1 := TSeries(Items[iSeries+1]);
if (pSeries1.NoPts > 0) then
begin
{Assign the top-left point:}
Pt10.x := pSeries1.XAxis.FofX(pSeries1.XData^[0]);
Pt10.y := pSeries1.YAxis.FofY(pSeries1.ZData);
Pt10.Z := pSeries1.YData^[0];
end;
end;
for i := 1 to pSeries0.NoPts-1 do
begin
{Assign the bottom-right point:}
Pt01.x := pSeries0.XAxis.FofX(pSeries0.XData^[i]);
Pt01.y := pSeries0.YAxis.FofY(pSeries0.ZData);
Pt01.Z := pSeries0.YData^[i];
{Oh yes it was: Delphi ain't that smart.}
if ((iSeries < Count-1) and (pSeries1.NoPts > 0)) then
begin
{Assign the top-right point:}
Pt11.x := pSeries1.XAxis.FofX(pSeries1.XData^[i]);
Pt11.y := pSeries1.YAxis.FofY(pSeries1.ZData);
Pt11.Z := pSeries1.YData^[i];
{Calculate the centrum:}
PtCentre.x := (Pt00.x + Pt01.x + Pt10.x + Pt11.x) div 4;
PtCentre.y := (Pt00.y + Pt01.y + Pt10.y + Pt11.y) div 4;
{Oh yes it was: see above}
PtCentre.Z := (Pt00.Z + Pt01.Z + Pt10.Z + Pt11.Z) / 4;
{just how detailed will the plot be ?}
case ContourDetail of
cdLow:
begin
{No triangles:}
ZFraction := (PtCentre.Z - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
ACanvas.Brush.Color := ACanvas.Pen.Color;
ACanvas.Polygon([
Point(Pt00.x,Pt00.y),
Point(Pt10.x,Pt10.y),
Point(Pt11.x,Pt11.y),
Point(Pt01.x,Pt01.y)]);
end;
cdMedium:
begin
{Left triangle, then Bottom, Top then Right:}
BltTriangle(Pt00, Pt10, PtCentre);
BltTriangle(Pt00, Pt01, PtCentre);
BltTriangle(Pt10, Pt11, PtCentre);
BltTriangle(Pt01, Pt11, PtCentre);
end;
cdHigh:
begin
{Left triangle, then Bottom, Top then Right:}
RenderTriangle(Pt00, Pt10, PtCentre);
RenderTriangle(Pt00, Pt01, PtCentre);
RenderTriangle(Pt10, Pt11, PtCentre);
RenderTriangle(Pt01, Pt11, PtCentre);
end;
end; {case}
{update values:}
Pt10.x := Pt11.x;
Pt10.y := Pt11.y;
Pt10.Z := Pt11.Z;
end; {not the final series}
Pt00.x := Pt01.x;
Pt00.y := Pt01.y;
Pt00.Z := Pt01.Z;
end; {loop over points}
{ACanvas.MoveTo(Pt00.x, Pt00.y);
ACanvas.LineTo(Pt10.x, Pt10.y);}
end; {NoPts}
end; {over every series}
{draw the color scale:}
DrawColorScale(ACanvas, TheMin, Span, ContourDetail);
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.SortTriangleVertices
Description: sorts the vertices of a triangle from highest Z value to lowest
Author: Mat Ballard
Date created: 07/17/2001
Date modified: 07/17/2001 by Mat Ballard
Purpose: 3D rendering
Known Issues: Pti have to be var, so that the location is passed.
------------------------------------------------------------------------------}
procedure TSeriesList.SortTriangleVertices(var Pt1, Pt2, Pt3: T3DZPoint; var p1, p2, p3: p3DZPoint);
begin
if (Pt1.Z >= Pt2.Z) then
begin
if (Pt2.Z >= Pt3.Z) then
begin
p1 := @Pt1;
p2 := @Pt2;
p3 := @Pt3;
end
else
begin {2 < 3:}
if (Pt1.Z >= Pt3.Z) then
begin
p1 := @Pt1;
p2 := @Pt3;
p3 := @Pt2;
end
else
begin
p1 := @Pt3;
p2 := @Pt1;
p3 := @Pt2;
end;
end;
end
else
begin {1 < 2}
if (Pt2.Z < Pt3.Z) then
begin
p1 := @Pt3;
p2 := @Pt2;
p3 := @Pt1;
end
else
begin {1 < 2 >= 3:}
if (Pt1.Z >= Pt3.Z) then
begin
p1 := @Pt2;
p2 := @Pt1;
p3 := @Pt3;
end
else
begin
p1 := @Pt2;
p2 := @Pt3;
p3 := @Pt1;
end;
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.SortTriangleVerticesOnY
Description: sorts the vertices of a triangle from highest Y value to lowest
Author: Mat Ballard
Date created: 07/17/2001
Date modified: 07/17/2001 by Mat Ballard
Purpose: 3D rendering
Known Issues: Pti have to be var, so that the location is passed.
------------------------------------------------------------------------------}
procedure TSeriesList.SortTriangleVerticesOnY(var Pt1, Pt2, Pt3: T3DRealPoint; var p1, p2, p3: p3DRealPoint);
begin
if (Pt1.Y >= Pt2.Y) then
begin
if (Pt2.Y >= Pt3.Y) then
begin
p1 := @Pt1;
p2 := @Pt2;
p3 := @Pt3;
end
else
begin {2 < 3:}
if (Pt1.Y >= Pt3.Y) then
begin
p1 := @Pt1;
p2 := @Pt3;
p3 := @Pt2;
end
else
begin
p1 := @Pt3;
p2 := @Pt1;
p3 := @Pt2;
end;
end;
end
else
begin {1 < 2}
if (Pt2.Y < Pt3.Y) then
begin
p1 := @Pt3;
p2 := @Pt2;
p3 := @Pt1;
end
else
begin {1 < 2 >= 3:}
if (Pt1.Y >= Pt3.Y) then
begin
p1 := @Pt2;
p2 := @Pt1;
p3 := @Pt3;
end
else
begin
p1 := @Pt2;
p2 := @Pt3;
p3 := @Pt1;
end;
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawLineContour
Description: standard Drawing procedure for 2.5D contour graphs
Author: Mat Ballard
Date created: 01/24/2001
Date modified: 07/15/2001 by Mat Ballard
Purpose: This draws all the series as a 2.5D coloured contour graph
Known Issues: Note that Y data is plotted as the color, and the Z data
as screen Y
------------------------------------------------------------------------------}
procedure TSeriesList.DrawLineContour(
ACanvas: TCanvas;
ContourStart, ContourInterval: Single;
ContourDetail: TContourDetail);
var
i, iSeries: Integer;
ZFraction,
TheMin,
Span: Single;
Pt00, Pt01, Pt10, Pt11, PtCentre: T3DZPoint;
pSeries0,
pSeries1: TSeries;
{This procedure performs a complex, three-color graded rendition of a triangle:}
procedure RenderTriangle(Pt1, Pt2, Pt3: T3DZPoint);
var
ii, mZ, nZ: Integer;
p1, p2, p3: p3DZPoint; //Highest, medium, lowest points in Z direction
{Sides of the triangle:}
P1P2, P1P3, P2P3,
{Pj is the left side of the triangle, Pk the right:}
Pj, Pk: T3DZPoint; //PjM1 = "P(j - 1)"
//dZ, dxj, dyj, dxk, dyk: Single;
begin
{sort the bastards first, on Z values:}
SortTriangleVertices(Pt1, Pt2, Pt3, p1, p2, p3);
{create the line vectors of the sides of the triangle:}
P1P2.x := p2^.x - p1^.x;
P1P2.y := p2^.y - p1^.y;
P1P2.Z := p2^.Z - p1^.Z;
P1P3.x := p3^.x - p1^.x;
P1P3.y := p3^.y - p1^.y;
P1P3.Z := p3^.Z - p1^.Z;
P2P3.x := p3^.x - p2^.x;
P2P3.y := p3^.y - p2^.y;
P2P3.Z := p3^.Z - p2^.Z;
{Get ready to loop: }
nZ := Round((p1^.Z - ContourStart) / ContourInterval);
mZ := Round((p3^.Z - ContourStart) / ContourInterval);
for ii := mZ to nZ do
begin
Pk.Z := ContourStart + ii * ContourInterval;
if ((p3^.Z <= Pk.Z) and (Pk.Z <= p1^.Z)) then
begin
{Calculate position of same Z on long right side:}
ZFraction := (Pk.Z-p1^.Z) / P1P3.Z;
Pk.x := p1^.x + Round(ZFraction * P1P3.x);
Pk.y := p1^.y + Round(ZFraction * P1P3.y);
{Calculate position of same Z on left or bottom side:}
Pj.Z := Pk.Z;
if (Pj.Z >= p2^.Z) then
begin {Left, upper half-triangle}
ZFraction := (Pj.Z-p1^.Z) / P1P2.Z;
Pj.x := p1^.x + Round(ZFraction * P1P2.x);
Pj.y := p1^.y + Round(ZFraction * P1P2.y);
end
else
begin {Bottom, lower half-triangle}
ZFraction := (Pj.Z-p2^.Z) / P2P3.Z;
Pj.x := p2^.x + Round(ZFraction * P2P3.x);
Pj.y := p2^.y + Round(ZFraction * P2P3.y);
end;
{Draw:}
if (ContourDetail > cdMedium) then
begin
ZFraction := (Pj.Z - TheMin) / Span;
ACanvas.Pen.Color := Misc.Rainbow(ZFraction);
end;
ACanvas.MoveTo(Pj.x,Pj.y);
ACanvas.LineTo(Pk.x,Pk.y);
end; {is in Z range}
end; {for}
end; {procedure RenderTriangle}
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawLineContour: ' + sACanvasIsNil);
{$ENDIF}
TheMin := Self.YMin;
Span := Self.YMax - ContourStart;
//ACanvas.Brush.Style := bsSolid;
if (ContourDetail = cdLow) then
ACanvas.Pen.Color := clBlack;
if (ContourDetail = cdMedium) then
ACanvas.Pen.Color := TSeries(Items[0]).Pen.Color;
{Draw each individual series:}
for iSeries := 0 to Self.Count-1 do
begin
pSeries0 := TSeries(Items[iSeries]);
if (pSeries0.NoPts > 0) then
begin
{Assign the bottom-left point:}
Pt00.x := pSeries0.XAxis.FofX(pSeries0.XData^[0]);
{Note: for contours, we plot the Y data as a function of X and Z,
so that Y determines the color, and Z determines the screen Y value.
The reason for this is that most data will be in the form of scans (series)
at repeated times.}
Pt00.y := pSeries0.YAxis.FofY(pSeries0.ZData);
Pt00.Z := pSeries0.YData^[0];
if (iSeries < Count-1) then
begin
pSeries1 := TSeries(Items[iSeries+1]);
if (pSeries1.NoPts > 0) then
begin
{Assign the top-left point:}
Pt10.x := pSeries1.XAxis.FofX(pSeries1.XData^[0]);
Pt10.y := pSeries1.YAxis.FofY(pSeries1.ZData);
Pt10.Z := pSeries1.YData^[0];
end;
end;
for i := 1 to pSeries0.NoPts-1 do
begin
{Assign the bottom-right point:}
Pt01.x := pSeries0.XAxis.FofX(pSeries0.XData^[i]);
Pt01.y := pSeries0.YAxis.FofY(pSeries0.ZData);
Pt01.Z := pSeries0.YData^[i];
{Oh yes it was: Delphi ain't that smart.}
if ((iSeries < Count-1) and (pSeries1.NoPts > 0)) then
begin
{Assign the top-right point:}
Pt11.x := pSeries1.XAxis.FofX(pSeries1.XData^[i]);
Pt11.y := pSeries1.YAxis.FofY(pSeries1.ZData);
Pt11.Z := pSeries1.YData^[i];
{Calculate the centrum:}
PtCentre.x := (Pt00.x + Pt01.x + Pt10.x + Pt11.x) div 4;
PtCentre.y := (Pt00.y + Pt01.y + Pt10.y + Pt11.y) div 4;
{Oh yes it was: see above}
PtCentre.Z := (Pt00.Z + Pt01.Z + Pt10.Z + Pt11.Z) / 4;
{just how detailed will the plot be ?}
RenderTriangle(Pt00, Pt10, PtCentre);
RenderTriangle(Pt00, Pt01, PtCentre);
RenderTriangle(Pt10, Pt11, PtCentre);
RenderTriangle(Pt01, Pt11, PtCentre);
{update values:}
Pt10.x := Pt11.x;
Pt10.y := Pt11.y;
Pt10.Z := Pt11.Z;
end; {not the final series}
Pt00.x := Pt01.x;
Pt00.y := Pt01.y;
Pt00.Z := Pt01.Z;
end; {loop over points}
end; {NoPts}
end; {over every series}
{draw the color scale:}
if (ContourDetail > cdMedium) then
begin
ACanvas.Brush.Style := bsSolid;
DrawColorScale(ACanvas, TheMin, Span, ContourDetail);
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawColorScale
Description: draws the Color Scale for Contour plots
Author: Mat Ballard
Date created: 03/06/2001
Date modified: 03/06/2001 by Mat Ballard
Purpose: contour plot details
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawColorScale(ACanvas: TCanvas; TheMin, Span: Single; TheContourDetail: TContourDetail);
var
i,
iX, iXp1, iY,
FontHeight: Integer;
TheText: String;
begin
iX := FXAxis.Right + FXAxis.Width div 50;
iXp1 := iX + FXAxis.Width div 50;
if (TheContourDetail = cdHigh) then
begin
for iY := FYAxis.Bottom downto FYAxis.Top do
begin
ACanvas.Pen.Color := Misc.Rainbow((FYAxis.Bottom - iY) / (FYAxis.Bottom - FYAxis.Top));
ACanvas.Brush.Color := ACanvas.Pen.Color;
ACanvas.FillRect(Rect(iX, iY, iXp1, iY+1));
end;
end
else
begin {low, medium, high:}
for iY := FYAxis.Bottom downto FYAxis.Top do
begin
ACanvas.Pen.Color := Rainbow((FYAxis.Bottom - iY) / (FYAxis.Bottom - FYAxis.Top));
ACanvas.MoveTo(iX, iY);
ACanvas.LineTo(iXp1, iY);
end;
end;
{put some labels on it:}
ACanvas.Font.Assign(FYAxis.Labels.Font);
ACanvas.Brush.Style := bsClear;
FontHeight := ACanvas.TextHeight('9') div 2;
for i := 0 to 4 do
begin
iY := FYAxis.Bottom +
i * (FYAxis.Top - FYAxis.Bottom) div 4 - FontHeight;
TheText := FYAxis.LabelToStrF(TheMin);
ACanvas.TextOut(iXp1+2, iY, TheText);
TheMin := TheMin + Span / 4;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawHistory
Description: standard Drawing procedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: draws all the Series on a given canvas IN History MODE
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawHistory(ACanvas: TCanvas; HistoryX: Single);
var
i: Integer;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawHistory: ' + sACanvasIsNil);
{$ENDIF}
for i := 0 to Count-1 do
begin
TSeries(Items[i]).DrawHistory(ACanvas, HistoryX);
end; {loop over series}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawError
Description: extended Drawing procedure for linking multiple series
Author: Mat Ballard
Date created: 01/21/2001
Date modified: 01/21/2001 by Mat Ballard
Purpose: links Series in pairs on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawError(ACanvas: TCanvas);
var
i,
iX,
iY,
iSeries: Integer;
pSeries,
pErrorSeries: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawError: ' + sACanvasIsNil);
{$ENDIF}
iSeries := 0;
while (iSeries <= Self.Count-2) do
begin
pSeries := TSeries(Items[iSeries]);
pErrorSeries := TSeries(Items[iSeries+1]);
if (pSeries.Visible) then
begin
ACanvas.Pen.Assign(pSeries.Pen);
if ((pSeries.Symbol = syNone) or (pSeries.SymbolSize = 0)) then
begin
{no symbols:}
for i := 0 to Min(pSeries.NoPts, pErrorSeries.NoPts)-1 do
begin
{draw the vertical line:}
ACanvas.MoveTo(
pSeries.XAxis.FofX(pSeries.XData^[i]) + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i] - pErrorSeries.YData^[i]) + pSeries.DeltaY);
ACanvas.LineTo(
pSeries.XAxis.FofX(pSeries.XData^[i]) + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i] + pErrorSeries.YData^[i]) + pSeries.DeltaY);
{and the horizontal:}
if (pErrorSeries.ExternalXSeries) then
begin {no X errors:}
ACanvas.MoveTo(
pSeries.XAxis.FofX(pSeries.XData^[i]) - 5 + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY);
ACanvas.LineTo(
pSeries.XAxis.FofX(pSeries.XData^[i]) + 5 + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY);
end
else
begin {X errors:}
ACanvas.MoveTo(
pSeries.XAxis.FofX(pSeries.XData^[i] - pErrorSeries.XData^[i]) + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY);
ACanvas.LineTo(
pSeries.XAxis.FofX(pSeries.XData^[i] + pErrorSeries.XData^[i]) + pSeries.DeltaX,
pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY);
end; {X Errors}
end; {for}
end
else
begin
{symbols:}
for i := 0 to Min(pSeries.NoPts, pErrorSeries.NoPts)-1 do
begin
iX := pSeries.XAxis.FofX(pSeries.XData^[i]) + pSeries.DeltaX;
iY := pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY;
pSeries.DrawSymbol(ACanvas, iX, iY);
ACanvas.MoveTo(iX, iY - pSeries.SymbolSize);
ACanvas.LineTo(iX, pSeries.YAxis.FofY(pSeries.YData^[i] + pErrorSeries.YData^[i]));
ACanvas.MoveTo(iX, iY + pSeries.SymbolSize);
ACanvas.LineTo(iX, pSeries.YAxis.FofY(pSeries.YData^[i] - pErrorSeries.YData^[i]));
if (not pErrorSeries.ExternalXSeries) then
begin
ACanvas.MoveTo(iX - pSeries.SymbolSize, iY);
ACanvas.LineTo(pSeries.XAxis.FofX(pSeries.XData^[i] - pErrorSeries.XData^[i]), iY);
ACanvas.MoveTo(iX + pSeries.SymbolSize, iY);
ACanvas.LineTo(pSeries.XAxis.FofX(pSeries.XData^[i] + pErrorSeries.XData^[i]), iY);
end;
end; {for}
end; {if symbols}
end; {if visible}
Inc(iSeries, 2);
end; {while}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawBubble
Description: extended Drawing procedure for Bubble plots
Author: Mat Ballard
Date created: 04/11/2001
Date modified: 04/11/2001 by Mat Ballard
Purpose: links Series in pairs as Bubble plots
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawBubble(ACanvas: TCanvas; BubbleSize: Integer);
var
i,
iX,
iY,
iSeries,
YRadius: Integer;
BubbleMax: Single;
pSeries,
pBubbleSeries: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawBubble: ' + sACanvasIsNil);
{$ENDIF}
iSeries := 0;
while (iSeries <= Self.Count-2) do
begin
pSeries := TSeries(Items[iSeries]);
{every odd numbered series contains the Bubble height, and optionally the breadth:}
pBubbleSeries := TSeries(Items[iSeries+1]);
BubbleMax := 100 * pBubbleSeries.YMax / (BubbleSize * (FYAxis.Bottom - FYAxis.Top));
if (pSeries.Visible) then
begin
ACanvas.Pen.Assign(pSeries.Pen);
ACanvas.Brush.Assign(pSeries.Brush);
for i := 0 to Min(pSeries.NoPts, pBubbleSeries.NoPts)-1 do
begin
iX := pSeries.XAxis.FofX(pSeries.XData^[i]) + pSeries.DeltaX;
iY := pSeries.YAxis.FofY(pSeries.YData^[i]) + pSeries.DeltaY;
YRadius := Round(pBubbleSeries.YData^[i] / BubbleMax);
if (YRadius >= 0) then
ACanvas.Brush.Style := bsSolid
else
ACanvas.Brush.Style := bsCross;
ACanvas.Ellipse(iX - YRadius, iY - YRadius, iX + YRadius, iY + YRadius)
end; {for}
end; {if visible}
Inc(iSeries, 2);
end; {while}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawMultiple
Description: extended Drawing procedure for linking multiple series
Author: Mat Ballard
Date created: 09/21/2000
Date modified: 09/21/2000 by Mat Ballard
Purpose: links multiple Series on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawMultiple(
ACanvas: TCanvas;
Multiplicity: Byte;
MultiplePen: TPen;
MultiJoin1, MultiJoin2: Integer);
var
i,
j,
k,
iSeries,
NoGroups: Integer;
pSeries, pSeries2: TSeries;
DoMultiJoin: Boolean;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawMultiple: ' + sACanvasIsNil);
Assert(Multiplicity > 1, 'TSeriesList.DrawMultiple: ' + sDrawMultiple1);
{$ENDIF}
{are there two valid multijoined series ?}
DoMultiJoin := FALSE;
if ((0 <= MultiJoin1) and (MultiJoin1 < Self.Count) and
(0 <= MultiJoin2) and (MultiJoin2 < Self.Count) and
(MultiJoin1 <> MultiJoin2)) then
begin
{We don't draw MultiJoined series:}
TSeries(Items[MultiJoin1]).Symbol := syNone;
TSeries(Items[MultiJoin2]).Symbol := syNone;
DoMultiJoin := TRUE;
end;
{Draw the normal series lines and symbols:}
Self.Draw(ACanvas, High(Integer));
{Prepare for the vertical lines:}
ACanvas.Pen.Assign(MultiplePen);
{And MultiJoin symbols:}
if (DoMultiJoin) then
begin
ACanvas.Brush.Assign(TSeries(Items[MultiJoin1]).Brush);
end;
NoGroups := Count div Multiplicity;
for i := 0 to MinNoPts-1 do
begin
iSeries := -1;
for j := 1 to NoGroups do
begin
Inc(iSeries);
if (iSeries >= Count) then break;
pSeries := TSeries(Items[iSeries]);
ACanvas.MoveTo(
pSeries.XAxis.FofX(pSeries.XData^[i]),
pSeries.YAxis.FofY(pSeries.YData^[i]));
for k := 2 to Multiplicity do
begin
Inc(iSeries);
if (iSeries >= Count) then break;
pSeries := TSeries(Items[iSeries]);
ACanvas.LineTo(
pSeries.XAxis.FofX(pSeries.XData^[i]),
pSeries.YAxis.FofY(pSeries.YData^[i]));
end; {Multiplicity}
if (DoMultiJoin) then
begin
pSeries := TSeries(Items[MultiJoin1]);
pSeries2 := TSeries(Items[MultiJoin2]);
ACanvas.Rectangle(
pSeries.XAxis.FofX(pSeries.XData^[i]) - pSeries.SymbolSize,
pSeries.YAxis.FofY(pSeries.YData^[i]),
pSeries2.XAxis.FofX(pSeries2.XData^[i]) + pSeries.SymbolSize,
pSeries2.YAxis.FofY(pSeries2.YData^[i]));
end;
end; {NoGroups}
end; {MinNoPts}
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DrawHistoryMultiple
Description: extended Drawing procedure for linking multiple series in History mode
Author: Mat Ballard
Date created: 09/21/2000
Date modified: 09/21/2000 by Mat Ballard
Purpose: links multiple Series in History mode on a given canvas
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DrawHistoryMultiple(ACanvas: TCanvas; Multiplicity: Byte);
var
i,
j,
k,
iSeries,
NoGroups: Integer;
pSeries: TSeries;
begin
{$IFDEF DELPHI3_UP}
Assert(ACanvas <> nil, 'TSeriesList.DrawHistoryMultiple: ' + sACanvasIsNil);
Assert(Multiplicity > 1, 'TSeriesList.DrawHistoryMultiple: ' + sDrawMultiple1);
{$ENDIF}
{we set the pen mode so that a second call to DrawHistory
erases the curve on screen:}
ACanvas.Pen.Mode := pmNotXOR;
NoGroups := Count div Multiplicity;
for i := MinNoPts-1 downto 0 do
begin
iSeries := -1;
for j := 1 to NoGroups do
begin
Inc(iSeries);
if (iSeries >= Count) then break;
pSeries := TSeries(Items[iSeries]);
ACanvas.MoveTo(
pSeries.XAxis.FofX(pSeries.XData^[i]),
pSeries.YAxis.FofY(pSeries.YData^[i]));
for k := 2 to Multiplicity do
begin
Inc(iSeries);
if (iSeries >= Count) then break;
pSeries := TSeries(Items[iSeries]);
ACanvas.LineTo(
pSeries.XAxis.FofX(pSeries.XData^[i]),
pSeries.YAxis.FofY(pSeries.YData^[i]));
end; {Multiplicity}
end; {NoGroups}
end; {MinNoPts}
end;
{TSeriesList editing, both in designer and active modes -----------------------}
{------------------------------------------------------------------------------
Function: TSeriesList.CloneSeries
Description: Clones (Adds then Copies) a Series to a new one
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: creates, initializes, adds then copies a Series
Return Value: the Index of the new Series
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.CloneSeries(
TheSeries: Integer): Integer;
var
pClone,
pSeries: TSeries;
TheClone,
TheXSeries: Integer;
begin
if ((TheSeries < 0) or (TheSeries > Count-1)) then raise
ERangeError.CreateFmt(sCloneSeries1, [TheSeries, Count]);
{so lets create the clone: the XDataSeries is either nil, or an existing series}
pSeries := TSeries(Items[TheSeries]);
TheXSeries := -1;
if (pSeries.XDataSeries <> nil) then
TheXSeries := IndexOf(pSeries.XDataSeries);
TheClone := Add(TheXSeries);
pClone := TSeries(Items[TheClone]);
{set properties:}
pClone.YAxisIndex := pSeries.YAxisIndex;
pClone.DefSize := pSeries.DefSize;
pClone.DeltaX := pSeries.DeltaX;
{move the cloned series up by 20 pixels:}
pClone.DeltaY := pSeries.DeltaY - 30;
pClone.Name := sClone + sOf + pSeries.Name;
pClone.OnStyleChange:= pSeries.OnStyleChange;
pClone.OnDataChange:= pSeries.OnDataChange;
pClone.Pen.Style := pSeries.Pen.Style;
pClone.Pen.Width := pSeries.Pen.Width;
pClone.Symbol:= pSeries.Symbol;
pClone.SymbolSize:= pSeries.SymbolSize;
pClone.Visible:= pSeries.Visible;
{pClone.SeriesType := pSeries.SeriesType;}
{case pSeries.SeriesType of
stXY: pClone.AddData(pSeries.XData, pSeries.YData, nil, pSeries.NoPts);
stXY_Error: pClone.AddData(pSeries.XData, pSeries.YData, pSeries.YErrorData, pSeries.NoPts);
stXYZ: pClone.AddData(pSeries.XData, pSeries.YData, pSeries.ZData, pSeries.NoPts);
end;}
pClone.AddData(pSeries.XData, pSeries.YData, pSeries.NoPts);
pClone.ResetBounds;
pClone.GetBounds;
{AddData above fires the OnDataChange event for the series:}
{DoDataChange;}
CloneSeries := TheClone;
end;
{TSeriesList editing, both in designer and active modes -----------------------}
{------------------------------------------------------------------------------
Procedure: TSeriesList.DataAsHTMLTable
Description: creates a stringlist of the data as a HTML table
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: copying data
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DataAsHTMLTable(var TheData: TStringList);
{This puts the data into a stringlist for saving or copying}
var
i, j: Integer;
NoPtsMax: Integer;
pSeries: TSeries;
SubHeader: String;
begin
if (TheData = nil) then exit;
{Determine the maximum number of points in all the series:}
NoPtsMax := 0;
for i := 0 to Count-1 do
begin
if (NoPtsMax < TSeries(Items[i]).NoPts) then
NoPtsMax := TSeries(Items[i]).NoPts;
end;
{loop over all series:}
SubHeader := #9 + '<tr>';
for i := 0 to Count-1 do
begin
pSeries := TSeries(Items[i]);
{create the sub-headings:}
if (not pSeries.ExternalXSeries) then
begin
SubHeader := SubHeader + '<td>' + pSeries.Name + ' - ' + pSeries.XAxis.Title.Caption + '</td>';
end;
SubHeader := SubHeader + '<td>' + pSeries.Name + ' - ' + pSeries.YAxis.Title.Caption + '</td>';
{loop over points in each series:}
for j := 0 to pSeries.NoPts-1 do
begin
if (TheData.Count <= j) then
begin
{start a new row:}
TheData.Add(#9+#9+ '<tr>');
end;
if (not pSeries.ExternalXSeries) then
begin
TheData[j] := TheData[j] + '<td>' + FloatToStr(pSeries.XData^[j]) + '</td>';
end;
TheData[j] := TheData[j] + '<td>' + FloatToStr(pSeries.YData^[j]) + '</td>';
end; {loop over points}
for j := pSeries.NoPts to NoPtsMax-1 do
begin
if (TheData.Count <= j) then
begin
{start a new row:}
TheData.Add(#9+#9+ '<tr>');
end;
if (not pSeries.ExternalXSeries) then
begin
TheData[j] := TheData[j] + '<td></td>';
end;
TheData[j] := TheData[j] + '<td></td>';
end;
end; {loop over series}
SubHeader := SubHeader + '</tr>';
TheData.Insert(0, SubHeader);
TheData.Insert(0, '<table border=2 cellpadding=2 cellspacing=2>');
TheData.Add('</table>');
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.AppendStream
Description: puts the data collected since LastSavedPoint into a stringlist for saving or copying.
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: saving data
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.AppendStream(
AsText: Boolean;
Delimiter: Char;
TheStream: TMemoryStreamEx);
var
i: Integer;
NoPtsMax: Integer;
begin
if (TheStream = nil) then exit;
{Determine the maximum number of points in all the series:}
NoPtsMax := 0;
for i := 0 to Count-1 do
begin
if (NoPtsMax < TSeries(Items[i]).NoPts) then
NoPtsMax := TSeries(Items[i]).NoPts;
end;
if (AsText) then
GetTextStream(Delimiter, LastSavedPoint, NoPtsMax, TheStream)
else
GetBinaryStream(LastSavedPoint, NoPtsMax, TheStream);
LastSavedPoint := NoPtsMax-1;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.GetStream
Description: puts the data into a MemoryStream
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 03/07/2001 by Mat Ballard
Purpose: for saving or copying
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.GetStream(
AsText: Boolean;
Delimiter: Char;
var TheStream: TMemoryStream);
var
i,
NoPtsMax: Integer;
ALine: String;
pLine: array [0..1023] of char;
begin
if (TheStream = nil) then
TheStream := TMemoryStream.Create;
Self.GetSubHeaderStream(Delimiter, TheStream);
if (AsText) then
StrPCopy(pLine, 'Binary=0' + CRLF)
else
StrPCopy(pLine, 'Binary=1' + CRLF);
TheStream.Write(pLine, StrLen(pLine));
if (Count = 0) then exit;
{Determine the maximum number of points in all the series:}
NoPtsMax := 0;
for i := 0 to Count-1 do
begin
if (NoPtsMax < TSeries(Items[i]).NoPts) then
NoPtsMax := TSeries(Items[i]).NoPts;
end;
if (AsText) then
begin
ALine := 'ZData:' + Delimiter;
if (TSeries(Items[0]).XStringData <> nil) then
if (TSeries(Items[0]).XStringData.Count > 0) then
ALine := ALine + Delimiter;
ALine := ALine + FloatToStr(TSeries(Items[0]).ZData);
for i := 1 to Count-1 do
begin
if (not TSeries(Items[i]).ExternalXSeries) then
begin
if (TSeries(Items[i]).XStringData <> nil) then
if (TSeries(Items[i]).XStringData.Count > 0) then
ALine := ALine + Delimiter;
ALine := ALine + Delimiter;
end;
ALine := ALine + Delimiter +
FloatToStr(TSeries(Items[i]).ZData)
end;
ALine := ALine + CRLF;
{$IFDEF DELPHI1}
StrPCopy(pLine, ALine);
TheStream.Write(pLine, StrLen(pLine));
{$ELSE}
TheStream.Write(Pointer(ALine)^, Length(ALine));
{$ENDIF}
GetTextStream(Delimiter, 0, NoPtsMax-1, TheStream)
end
else
begin
ALine := 'ZData:';
{$IFDEF DELPHI1}
StrPCopy(pLine, ALine);
TheStream.Write(pLine, StrLen(pLine));
{$ELSE}
TheStream.Write(Pointer(ALine)^, Length(ALine));
{$ENDIF}
for i := 0 to Count-1 do
TheStream.Write(TSeries(Items[i]).ZData, SizeOf(Single));
GetBinaryStream(0, NoPtsMax-1, TheStream);
end;
FDataChanged := FALSE;
LastSavedPoint := NoPtsMax-1;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.GetSubHeaderStream
Description: puts the data sub header onto a stream
Author: Mat Ballard
Date created: 08/06/2000
Date modified: 08/06/2000 by Mat Ballard
Purpose: for saving or copying
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.GetSubHeaderStream(
Delimiter: Char;
TheStream: TMemoryStream);
var
i: Integer;
pSeries: TSeries;
SeriesNameLine,
AxisNameLine,
DataTypeLine,
XDataSeriesLine: String;
{$IFDEF DELPHI1}
pLine: array [0..4095] of char;
{$ENDIF}
begin
if (TheStream = nil) then exit;
{point at the first series:}
pSeries := TSeries(Items[0]);
{the first series ALWAYS has both an X data:}
SeriesNameLine := '';
AxisNameLine := pSeries.XAxis.Title.Caption;
DataTypeLine := 'X';
XDataSeriesLine := '-';
{maybe XTEXT data:}
if ((pSeries.XStringData <> nil) and
(pSeries.XStringData.Count > 0)) then
begin
SeriesNameLine := SeriesNameLine + Delimiter;
AxisNameLine := AxisNameLine + Delimiter;
DataTypeLine := DataTypeLine + Delimiter + 'XTEXT';
XDataSeriesLine := XDataSeriesLine + Delimiter + '-';
end;
{and ALWAYS has Y data:}
SeriesNameLine := SeriesNameLine + Delimiter + pSeries.Name;
AxisNameLine := AxisNameLine + Delimiter + pSeries.YAxis.Title.Caption;
DataTypeLine := DataTypeLine + Delimiter + 'Y';
XDataSeriesLine := XDataSeriesLine + Delimiter + '-';
{loop over all the rest of the series:}
for i := 1 to Count-1 do
begin
pSeries := TSeries(Items[i]);
{create the sub-headings:}
if (not pSeries.ExternalXSeries) then
begin
{The X data belongs to this series:}
SeriesNameLine := SeriesNameLine + Delimiter;
AxisNameLine := AxisNameLine + Delimiter + pSeries.XAxis.Title.Caption;
DataTypeLine := DataTypeLine + Delimiter + 'X';
XDataSeriesLine := XDataSeriesLine + Delimiter + '-';
if ((pSeries.XStringData <> nil) and
(pSeries.XStringData.Count > 0)) then
begin
SeriesNameLine := SeriesNameLine + Delimiter;
AxisNameLine := AxisNameLine + Delimiter;
DataTypeLine := DataTypeLine + Delimiter + 'XTEXT';
XDataSeriesLine := XDataSeriesLine + Delimiter + '-';
end;
end;
{The Y data belongs to this series:}
{put the Series Name and YAxis name above the Y column:}
SeriesNameLine := SeriesNameLine + Delimiter + pSeries.Name;
AxisNameLine := AxisNameLine + Delimiter + pSeries.YAxis.Title.Caption;
DataTypeLine := DataTypeLine + Delimiter + 'Y';
if (pSeries.ExternalXSeries) then
XDataSeriesLine := XDataSeriesLine + Delimiter +
IntToStr(IndexOf(pSeries.XDataSeries))
else
XDataSeriesLine := XDataSeriesLine + Delimiter;
end; {for i}
SeriesNameLine := SeriesNameLine + CRLF;
AxisNameLine := AxisNameLine + CRLF;
DataTypeLine := DataTypeLine + CRLF;
XDataSeriesLine := XDataSeriesLine + CRLF;
{$IFDEF DELPHI1}
StrPCopy(pLine, SeriesNameLine);
TheStream.Write(pLine, StrLen(pLine));
StrPCopy(pLine, AxisNameLine);
TheStream.Write(pLine, StrLen(pLine));
StrPCopy(pLine, DataTypeLine);
TheStream.Write(pLine, StrLen(pLine));
StrPCopy(pLine, XDataSeriesLine);
TheStream.Write(pLine, StrLen(pLine));
{$ELSE}
TheStream.Write(Pointer(SeriesNameLine)^, Length(SeriesNameLine));
TheStream.Write(Pointer(AxisNameLine)^, Length(AxisNameLine));
TheStream.Write(Pointer(DataTypeLine)^, Length(DataTypeLine));
TheStream.Write(Pointer(XDataSeriesLine)^, Length(XDataSeriesLine));
{$ENDIF}
end;
{------------------------------------------------------------------------------
procedure: TSeriesList.GetBinaryStream
Description: gets the data as a binary stream
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management: copying and saving
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.GetBinaryStream(
Start, Finish: Integer;
TheStream: TMemoryStream);
var
i,
j: Integer;
pSeries: TSeries;
pNullData: array [0..16] of char;
pLine: array [0..255] of char;
procedure WriteStringData;
begin
if (pSeries.XStringData <> nil) then
if (pSeries.XStringData.Count > 0) then
begin
if (i < pSeries.XStringData.Count) then
StrPCopy(pLine, pSeries.XStringData.Strings[i] + CRLF)
else
StrPCopy(pLine, CRLF);
TheStream.Write(pLine, StrLen(pLine));
end;
end;
begin
for i := 0 to SizeOf(Single)-1 do
pNullData[i] := 'x';
pNullData[SizeOf(Single)] := Chr(0);
{all the data is written in BINARY format:}
for i := Start to Finish do
begin
{loop over all series:}
for j := 0 to Count-1 do
begin
pSeries := TSeries(Items[j]);
if (i < pSeries.NoPts) then
begin
if (not pSeries.ExternalXSeries) then
begin
TheStream.Write(pSeries.XData^[i], SizeOf(Single));
WriteStringData;
end;
TheStream.Write(pSeries.YData^[i], SizeOf(Single));
end
else
begin
if (not pSeries.ExternalXSeries) then
begin
TheStream.Write(pNullData, SizeOf(Single));
WriteStringData;
end;
TheStream.Write(pNullData, SizeOf(Single));
end;
end; {loop over points}
end;
end;
{------------------------------------------------------------------------------
procedure: TSeriesList.GetTextStream
Description: gets the data as a text stream
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: data management: copying and saving
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.GetTextStream(
Delimiter: Char;
Start, Finish: Integer;
TheStream: TMemoryStream);
var
i,
j: Integer;
pSeries: TSeries;
//DoStringXData: Boolean;
TheLine: String;
{$IFDEF DELPHI1}
pLine: array [0..255] of char;
{$ENDIF}
procedure WriteStringData;
begin
if (pSeries.XStringData <> nil) then
if (pSeries.XStringData.Count > 0) then
begin
if (i < pSeries.XStringData.Count) then
TheLine := TheLine + Delimiter + pSeries.XStringData.Strings[i]
else
TheLine := TheLine + Delimiter;
end;
end;
begin
{all the data is written in text format:}
for i := Start to Finish do
begin
{loop over all the remaining series:}
for j := 0 to Count-1 do
begin
pSeries := TSeries(Items[j]);
if (i < pSeries.NoPts) then
begin
if (not pSeries.ExternalXSeries) then
begin
TheLine := FloatToStr(pSeries.XData^[i]);
WriteStringData;
end;
TheLine := TheLine + Delimiter + FloatToStr(pSeries.YData^[i]);
end
else
begin
if (not pSeries.ExternalXSeries) then
begin
TheLine := TheLine + Delimiter;
WriteStringData;
end;
TheLine := TheLine + Delimiter;
end;
end; {loop over points}
TheLine := TheLine + CRLF;
{$IFDEF DELPHI1}
StrPCopy(pLine, TheLine);
TheStream.Write(pLine, StrLen(pLine));
{$ELSE}
TheStream.Write(Pointer(TheLine)^, Length(TheLine));
{$ENDIF}
end;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.LoadFromStream
Description: Opens data on disk
Author: Mat Ballard
Date created: 04/25/2001
Date modified: 04/25/2001 by Mat Ballard
Purpose: Opens data, parses it, fires the OnHeader event, and runs ConvertTextData,
or decides to run it through ParseData instead
Known Issues: Called by TPlot.LoadFromStream
------------------------------------------------------------------------------}
function TSeriesList.LoadFromStream(
AStream: TMemoryStream; var AsText: Boolean): Boolean;
var
TheResult: Boolean;
ColCount,
//FileVersion,
i,
iColumn,
InitialSeriesCount,
//LineLength,
NoFileSeries: Integer;
TheLine,
SeriesNameLine,
AxisNameLine,
DataTypeLine,
XDataSeriesLine,
TheCell: String;
TheStrings: TStringList;
SeriesInfo: pSeriesInfoArray;
SeriesOfCol: pIntegerArray;
//OldIgnoreChanges: Boolean;
procedure CleanUp;
begin
if (SeriesInfo <> nil) then
FreeMem(SeriesInfo, ColCount * SizeOf(TSeriesInfo));
SeriesInfo := nil;
if (SeriesOfCol <> nil) then
FreeMem(SeriesOfCol, ColCount * SizeOf(Integer));
SeriesOfCol := nil;
if (TheStrings <> nil) then
TheStrings.Free;
TheStrings := nil;
end;
begin
//LoadFromStream := FALSE;
ColCount := 1;
SeriesInfo := nil;
SeriesOfCol := nil;
TheStrings := nil;
InitialSeriesCount := Self.Count;
try
{get the sub-header data:}
SeriesNameLine := ReadLine(AStream);
AxisNameLine := ReadLine(AStream);
DataTypeLine := ReadLine(AStream);
XDataSeriesLine := ReadLine(AStream);
{find out how many columns there are:}
for i := 1 to Length(DataTypeLine) do
if (DataTypeLine[i] = ',') then
Inc(ColCount);
if (ColCount < 2) then raise
EFOpenError.CreateFmt(sLoadFromStream1, [ColCount]);
{allocate memory for the dynamic arrays, which are small:}
GetMem(SeriesInfo, ColCount * SizeOf(TSeriesInfo));
GetMem(SeriesOfCol, (ColCount+1) * SizeOf(Integer));
{this allocates more memory than SeriesInfo needs, but so what ?}
{Determine the number of series:}
NoFileSeries := 0;
for i := 0 to ColCount-1 do
begin
SeriesInfo^[i].XCol := 0;
SeriesInfo^[i].XTextCol := -1;
end;
{examine the columns one by one:}
for iColumn := 1 to ColCount do
begin
{No new column yet belongs to a Series:}
SeriesOfCol^[iColumn] := -1;
TheCell := GetWord(DataTypeLine, ',');
if (TheCell = 'X') then
begin
{we've found a X data column to add.}
SeriesOfCol^[iColumn] := NoFileSeries;
SeriesInfo^[NoFileSeries].XCol := iColumn;
GetWord(XDataSeriesLine, ',');
GetWord(SeriesNameLine, ',');
end
else if (TheCell = 'XTEXT') then
begin
{we've found a X STRING data column to add.}
SeriesOfCol^[iColumn] := NoFileSeries;
SeriesInfo^[NoFileSeries].XTextCol := iColumn;
GetWord(XDataSeriesLine, ',');
GetWord(SeriesNameLine, ',');
end
else if (TheCell = 'Y') then
begin
{we've found a Y data column to add.}
SeriesInfo^[NoFileSeries].YCol := iColumn;
{find the X Column that this Y column uses:}
TheCell := GetWord(XDataSeriesLine, ',');
if (TheCell = '-') then
begin
SeriesInfo^[NoFileSeries].XSeriesIndex := -1;
end
else
begin
SeriesInfo^[NoFileSeries].XSeriesIndex :=
StrToInt(TheCell) + InitialSeriesCount;
end;
{Add a new series:}
SeriesInfo^[NoFileSeries].Index :=
Self.Add(SeriesInfo^[NoFileSeries].XSeriesIndex);
TSeries(Self.Items[SeriesInfo^[NoFileSeries].Index]).Name :=
GetWord(SeriesNameLine, ',');
Inc(NoFileSeries);
end; {found a Y data column}
end; {for}
{Get the type of data:}
TheLine := ReadLine(AStream);
GetWord(TheLine, '=');
{'Binary=X': X=0 => Text, X=1 => Binary:}
i := StrToInt(TheLine);
{now we try to convert all the data:}
if (i = 0) then
begin {text}
TheStrings := TStringList.Create;
{although not documented, TStrings.LoadFromStream starts from
the CURRENT TStream.Position ! Ain't that nice !}
TheStrings.LoadFromStream(AStream);
TheResult := Self.ConvertTextData(ColCount, NoFileSeries, 0, ',', TheStrings, SeriesInfo);
AsText := TRUE;
end
else if (i = 1) then
begin {binary}
TheResult := Self.ConvertBinaryData(ColCount, NoFileSeries, AStream, SeriesInfo);
AsText := FALSE;
end
else
begin
raise EFOpenError.Create(sLoadFromFile1);
end;
{new data has not changed:}
Self.DataChanged := FALSE;
except
CleanUp;
raise;
end; {try}
for i := InitialSeriesCount to Self.Count-1 do
TSeries(Self.Items[i]).GetBounds;
LoadFromStream := TheResult;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetNearestPoint
Description: gets the nearest series and point to the input point
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: user selection of data on screen
Return Value: the Index of the nearest point
Known Issues: 1. this is a long and messy function: while some parts could be done
lower done in TSeries, other bits can't. i am still not
completely happy with it.
2. We "GenerateXXXOutline" here for Columns and Pies, but not for XY types.
------------------------------------------------------------------------------}
function TSeriesList.GetNearestPoint(
ThePlotType: TPlotType;
ColumnGap,
iX, iY: Integer;
var TheSeries: Integer;
var MinDistance: Single;
var pSeries: TSeries): Integer;
var
CellWidth, CellHeight,
iCol, jRow, NoPieCols,
iSeries,
NearestPoint,
PieLeft, PieTop, PieWidth, PieHeight: Integer;
Distance, dX, Span, X, Y,
YSum, YNegSum, YSumOld, YNegSumOld, YTotal, YNegTotal: Single;
pSeriesi: TSeries;
function GetColumnIndex: Boolean;
begin
GetColumnIndex := FALSE;
{all column plots use Series[0].XData:}
pSeriesi := TSeries(Self.Items[0]);
X := FXAxis.XofF(iX);
{bug out if outside span:}
if (X < pSeriesi.XData^[0]) then exit;
dX := ((100 - ColumnGap) / 100) * (
pSeriesi.XData^[pSeriesi.NoPts-1] -
pSeriesi.XData^[pSeriesi.NoPts-2]);
if (X > pSeriesi.XData^[pSeriesi.NoPts-1] + dX) then exit;
{find the nearest point:}
NearestPoint := pSeriesi.GetNearestPointToFX(iX);
if (NearestPoint <> 0) then
if (X < pSeriesi.XData^[NearestPoint]) then
Dec(NearestPoint);
if (NearestPoint = pSeriesi.NoPts-1) then
Span := pSeriesi.XData^[NearestPoint] - pSeriesi.XData^[NearestPoint-1]
else
Span := pSeriesi.XData^[NearestPoint+1] - pSeriesi.XData^[NearestPoint];
dX := ((100 - ColumnGap) / 100) * Span;
{was the click in the gap between bars ?}
if (X > pSeriesi.XData^[NearestPoint] + dX) then
exit;
GetColumnIndex := TRUE;
end;
begin
Distance := 1.0e38;
MinDistance := 1.0e38;
TheSeries := -1;
GetNearestPoint := -1;
pSeries := nil;
if (Self.Count = 0) then exit;
iSeries := 0;
case ThePlotType of
ptXY, ptError, ptMultiple, ptBubble:
begin
{loop over series: note that ptError and ptBubble skips every second series -
the error/size ones}
while (iSeries < Count) do
begin
pSeriesi := TSeries(Self.Items[iSeries]);
{Find the nearest point IN THIS SERIES:}
NearestPoint := pSeriesi.GetNearestXYPoint(
iX, iY,
0, 0,
Distance);
{Mirror, Mirror on the wall,
who is the nearest one of all ?}
if (Distance < MinDistance) then
begin
GetNearestPoint := NearestPoint;
MinDistance := Distance;
TheSeries := iSeries;
pSeries := pSeriesi;
end;
{Note: we don't pSeries.GenerateXYOutline here, because that would be running
that method every time the screen got clicked on, which is a bit of a drain.
However, we do run pSeries.GenerateColumnOutline and pSeries.GeneratePieOutline
because they are simple assignments.}
{ptError: every second series is just the X and Y error:}
if ((ThePlotType = ptError) or
(ThePlotType = ptBubble)) then
Inc(iSeries, 2)
else
Inc(iSeries);
end; {while over series}
end;
ptColumn:
begin
if (not GetColumnIndex) then
exit;
{now home in: which series was it:}
TheSeries := 0;
if (Self.Count > 1) then
TheSeries := Trunc(Self.Count * (X - pSeriesi.XData^[NearestPoint]) / dX);
{we now know which point in which series:}
pSeries := TSeries(Self.Items[TheSeries]);
Y := FYAxis.YofF(iY);
if (Y > pSeries.YData^[NearestPoint]) then
exit;
if ((Y < 0) and (Y < pSeries.YData^[NearestPoint])) then
exit;
GetNearestPoint := NearestPoint;
MinDistance := 0;
pSeries.GenerateColumnOutline(
FXAxis.FofX(pSeries.XData^[NearestPoint] + TheSeries * dX / Self.Count),
FYAxis.FofY(0),
FXAxis.FofX(pSeries.XData^[NearestPoint] + (TheSeries+1) * dX / Self.Count),
FYAxis.FofY(pSeries.YData^[NearestPoint]));
end;
ptStack, ptNormStack:
begin
if (not GetColumnIndex) then
exit;
Y := FYAxis.YofF(iY);
{now home in: which series was it:}
TheSeries := 0;
YSum := 0;
YNegSum := 0;
YTotal := 0;
YNegTotal := 0;
if (ThePlotType = ptNormStack) then
{ptStack and ptNormStack are pretty similar expcept for ...}
begin
if ((Y < 0) or (Y > 100)) then
exit;
{count every series:}
for iSeries := 0 to Count-1 do
begin
if (TSeries(Items[iSeries]).YData^[NearestPoint] >= 0) then
YTotal := YTotal + TSeries(Items[iSeries]).YData^[NearestPoint]
else
YNegTotal := YNegTotal + TSeries(Items[iSeries]).YData^[NearestPoint];
end; {count every series}
{prepare for conversion of data to percent:}
YTotal := YTotal / 100;
YNegTotal := - YNegTotal / 100;
end;
{loop over every series:}
for iSeries := 0 to Count-1 do
begin
pSeries := TSeries(Items[iSeries]);
if (pSeries.YData^[NearestPoint] >= 0) then
begin
YSumOld := YSum;
if (ThePlotType = ptStack) then
YSum := YSum + pSeries.YData^[NearestPoint]
else {ptNormStack}
YSum := YSum + pSeries.YData^[NearestPoint] / YTotal;
if ((YSumOld < Y) and (Y < YSum)) then
begin {Bingo !}
GetNearestPoint := NearestPoint;
MinDistance := 0;
pSeries.GenerateColumnOutline(
FXAxis.FofX(pSeries.XData^[NearestPoint]),
FYAxis.FofY(YSumOld),
FXAxis.FofX(pSeries.XData^[NearestPoint] + dX),
FYAxis.FofY(YSum));
break;
end;
end
else
begin
YNegSumOld := YNegSum;
if (ThePlotType = ptStack) then
YNegSum := YNegSum + pSeries.YData^[NearestPoint]
else {ptNormStack}
YNegSum := YNegSum + pSeries.YData^[NearestPoint] / YNegTotal;
if ((YNegSum < Y) and (Y < YNegSumOld)) then
begin {Bingo !}
GetNearestPoint := NearestPoint;
MinDistance := 0;
pSeries.GenerateColumnOutline(
FXAxis.FofX(pSeries.XData^[NearestPoint]),
FYAxis.FofY(YNegSumOld),
FXAxis.FofX(pSeries.XData^[NearestPoint] + dX),
FYAxis.FofY(YNegSum));
break;
end;
end; {YData >= 0}
end; {for iSeries}
end;
ptPie:
begin
{each Pie sits in a cell:}
NoPieCols := Trunc(0.99 + Count / NoPieRows);
CellWidth := (PlotBorder.Right - PlotBorder.Left) div NoPieCols;
CellHeight := (PlotBorder.Bottom - PlotBorder.Top) div NoPieRows;
{... but does not occupy the entire cell:}
PieWidth := Round(PIE_SIZE * CellWidth);
PieHeight := Round(PIE_SIZE * CellHeight);
if (PieHeight > PieWidth) then
PieHeight := PieWidth;
iSeries := 0;
for iCol := 0 to NoPieCols-1 do
begin
for jRow := 0 to NoPieRows-1 do
begin
if (iSeries >= Count) then break;
{indent the (left, top) a bit:}
PieLeft := PlotBorder.Left + iCol * CellWidth +
(CellWidth-PieWidth) div 2;
PieTop := PlotBorder.Top + jRow * CellHeight +
(CellHeight-PieHeight) div 2;
pSeries := TSeries(Self.Items[iSeries]);
{Find the nearest point IN THIS SERIES:}
NearestPoint := pSeries.GetNearestPieSlice(
iX, iY,
PieLeft, PieTop, PieWidth, PieHeight,
Distance);
if (Distance = 0) then
begin
GetNearestPoint := NearestPoint;
MinDistance := Distance;
TheSeries := iSeries;
pSeries.GeneratePieOutline(
PieLeft,
PieTop,
PieWidth,
PieHeight,
NearestPoint);
break;
end;
Inc(iSeries);
end; {jRow}
end; {iCol}
end; {ptPie}
ptPolar:
begin
end;
end; {case}
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetSeriesOfZ
Description: gets the series with ZData ZValue
Author: Mat Ballard
Date created: 04/25/2001
Date modified: 04/25/2001 by Mat Ballard
Purpose: parsing data from strange files
Return Value: the guilty series, or nil
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetSeriesOfZ(ZValue: Single): TSeries;
var
i: Integer;
begin
GetSeriesOfZ := nil;
for i := 0 to Self.Count-1 do
begin
if (ZValue = TSeries(Self.Items[i]).ZData) then
begin
GetSeriesOfZ := TSeries(Self.Items[i]);
break;
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DoChange
Description: event firing proedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: fires the OnDataChange event
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DoStyleChange;
begin
if Assigned(FOnStyleChange) then OnStyleChange(Self);
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DoDataChange
Description: event firing proedure
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: fires the OnDataChange event
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.DoDataChange;
begin
FDataChanged := TRUE;
if Assigned(FOnDataChange) then OnDataChange(Self);
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetTotalNoPts
Description: standard property Get function
Author: Mat Ballard
Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
Purpose: gets the value of the TotalNoPts Property
Return Value: Integer
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetTotalNoPts: Integer;
var
i,
Sum: Integer;
begin
{loop over all series:}
Sum := 0;
for i := 0 to Count-1 do
begin
Sum := Sum + TSeries(Items[i]).NoPts;
end;
GetTotalNoPts := Sum;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetMaxNoPts
Description: standard property Get function
Author: Mat Ballard
Date created: 09/21/2000
Date modified: 09/21/2000 by Mat Ballard
Purpose: gets the value of the MaxNoPts Property
Return Value: Integer
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetMaxNoPts: Integer;
var
i,
TheMax: Integer;
begin
TheMax := 0;
if (Count > 0) then
begin
TheMax := TSeries(Items[0]).NoPts;
for i := 1 to Count-1 do
begin
if (TheMax < TSeries(Items[i]).NoPts) then
TheMax := TSeries(Items[i]).NoPts;
end;
end;
GetMaxNoPts := TheMax;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.GetMinNoPts
Description: standard property Get function
Author: Mat Ballard
Date created: 09/21/2000
Date modified: 09/21/2000 by Mat Ballard
Purpose: gets the value of the MinNoPts Property
Return Value: Integer
Known Issues:
------------------------------------------------------------------------------}
function TSeriesList.GetMinNoPts: Integer;
var
i,
TheMin: Integer;
begin
TheMin := 0;
if (Count > 0) then
begin
TheMin := TSeries(Items[0]).NoPts;
for i := 1 to Count-1 do
begin
if (TheMin < TSeries(Items[i]).NoPts) then
TheMin := TSeries(Items[i]).NoPts;
end;
end;
GetMinNoPts := TheMin;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.ParseData
Description: oversees the importation and pasting of data
Author: Mat Ballard
Date created: 12/1/1999
Date modified: 04/27/2001 by Mat Ballard
Purpose: runs the ParserForm, and adds the new data as new Axis
Return Value: TRUE is successful
Known Issues: moved from TCustomPlot
------------------------------------------------------------------------------}
function TSeriesList.ParseData(
TheData: TStringList;
TheHelpFile: String): Boolean;
var
i,
InitialSeriesCount,
iColumn,
jRow,
NoPastedSeries,
NoXs, NoYs, NoZs,
XSeriesCol: Integer;
Delimiter,
ZDataLine,
ZValue: String;
ParserForm: TParserForm;
SeriesInfo: pSeriesInfoArray;
SeriesOfCol: pIntegerArray;
begin
ParseData := FALSE;
InitialSeriesCount := Self.Count;
ParserForm := TParserForm.Create(nil);
jRow := 0;
try
for jRow := 0 to TheData.Count-1 do
begin
ParserForm.DataListBox.Items.Add(TheData.Strings[jRow]);
end;
jRow := 0;
except
{the file was to big to place into the listbox:}
ShowMessageFmt(sParseData1, [jRow-1]);
end;
ParserForm.HelpFile := TheHelpFile;
if (ParserForm.ShowModal = mrOK) then
begin
Delimiter := ParserForm.Delimiters[ParserForm.TheDelimiter];
NoXs := 0;
NoYs := 0;
NoZs := 0;
for iColumn := 1 to ParserForm.InfoGrid.ColCount-1 do
begin
if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'X') then
Inc(NoXs)
else if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'Y') then
Inc(NoYs)
else if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'Z') then
Inc(NoZs)
end;
ZDataLine := ParserForm.InfoGrid.Rows[X_OR_Y_OR_Z].CommaText;
{The data might be in the form of:
x1,y1,z1
x2,y2,z2
...
or in the form of columns of series (ie: like we save it):}
if (NoZs > 0) then
begin
if ((NoXs = NoYs) and (NoYs = NoZs)) then
begin
ParseData := ConvertXYZData(ParserForm.TheFirstDataLine,
Delimiter, ParserForm.InfoGrid.Rows[X_OR_Y_OR_Z], TheData);
end
else
ShowMessage(sSorryTooComplex);
end
else
begin
{allocate memory for the dynamic arrays, which are small:}
GetMem(SeriesInfo, ParserForm.InfoGrid.ColCount * SizeOf(TSeriesInfo));
GetMem(SeriesOfCol, (ParserForm.InfoGrid.ColCount+1) * SizeOf(Integer));
{this allocates more memory than SeriesInfo needs, but so what ?}
for i := 0 to ParserForm.InfoGrid.ColCount-1 do
begin
SeriesInfo^[i].XCol := 0;
SeriesInfo^[i].XTextCol := -1;
end;
if (NoXs = 0) then
SeriesInfo^[0].XCol := -2;
{Grab the line of Z Data, if any:}
{This is complex: ConvertTextData expects the Z Data line, if present,
to be String[FirstLine] AND to start with 'ZData' - because this is the
TPlot file format. However, this may NOT be the case with third party text
files: the Z Data could come anywhere, or it could even be manually entered
by the user. Because of these problems, we process the Z Data in this
routine, then remove any Z references from the Z Data Line.}
if (ParserForm.TheZDataLine >= 0) then
begin
ZDataLine := Uppercase(TheData.Strings[ParserForm.TheZDataLine]);
iColumn := Pos('ZDATA', ZDataLine);
if (iColumn > 0) then
begin
{remove ZDATA because we process it in this routine:}
TheData.Strings[ParserForm.TheZDataLine] :=
Copy(ZDataLine, 1, iColumn-1) +
Copy(ZDataLine, iColumn+5, 9999);
end;
end
else
begin
{The user may have entered Z Data manually:}
ZDataLine := '';
for iColumn := 1 to ParserForm.InfoGrid.ColCount-1 do
begin
if (Length(ParserForm.InfoGrid.Cells[iColumn, Z_DATA_LINE]) > 0) then
begin
ZDataLine := ZDataLine +
ParserForm.InfoGrid.Cells[iColumn, Z_DATA_LINE] + Delimiter;
end;
end;
end;
{Determine the number of series:}
NoPastedSeries := 0;
{examine the columns one by one:}
for iColumn := 1 to ParserForm.InfoGrid.ColCount-1 do
begin
SeriesOfCol^[iColumn] := -1;
if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'X') then
begin
{This is a column of X data:}
SeriesOfCol^[iColumn] := NoPastedSeries;
SeriesInfo^[NoPastedSeries].XCol := iColumn;
end
else if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'XTEXT') then
begin
{This is a column of X STRING data:}
SeriesOfCol^[iColumn] := NoPastedSeries;
SeriesInfo^[NoPastedSeries].XTextCol := iColumn;
end
else if (ParserForm.InfoGrid.Cells[iColumn, X_OR_Y_OR_Z] = 'Y') then
begin
{we've found a series - this is a column of Y data:}
SeriesOfCol^[iColumn] := NoPastedSeries;
SeriesInfo^[NoPastedSeries].YCol := iColumn;
if (Length(ParserForm.InfoGrid.Cells[iColumn,DEPENDS_ON_X]) > 0) then
begin
XSeriesCol := StrToInt(ParserForm.InfoGrid.Cells[iColumn,DEPENDS_ON_X]);
if (SeriesOfCol^[XSeriesCol] < 0) then
raise EComponentError.Create('TCustomPlot.ParseData: ' + sParseData2);
if (SeriesOfCol^[XSeriesCol] = NoPastedSeries) then
begin
{This column of Y Data has its own X Data (column):}
SeriesInfo^[NoPastedSeries].XSeriesIndex := -1;
end
else
begin
{This column of Y Data uses another Series X Data (column):}
SeriesInfo^[NoPastedSeries].XSeriesIndex :=
SeriesOfCol^[XSeriesCol] + InitialSeriesCount;
end;
end;
{This Y Column has come before any X columns:}
if (iColumn = 1) then
SeriesInfo^[NoPastedSeries].XSeriesIndex := -1;
{There is no X data at all !}
if ((NoXs = 0) and (iColumn > 1)) then
SeriesInfo^[NoPastedSeries].XSeriesIndex :=
InitialSeriesCount;
{We add the new series:}
SeriesInfo^[NoPastedSeries].Index :=
Self.Add(SeriesInfo^[NoPastedSeries].XSeriesIndex);
{and set its name:}
TSeries(Self.Items[SeriesInfo^[NoPastedSeries].Index]).Name :=
ParserForm.InfoGrid.Cells[iColumn, SERIES_NAMES];
{and its Z value:}
if (Length(ZDataLine) > 0) then
begin
repeat
ZValue := GetWord(ZDataLine, Delimiter);
if IsReal(ZValue) then
begin
try
TSeries(Self.Items[SeriesInfo^[NoPastedSeries].Index]).ZData :=
StrToFloat(ZValue);
ZValue := '';
except
On EConvertError do
ZValue := '?';
end;
end
else
ZValue := '?';
until ((Length(ZValue) = 0) or (Length(ZDataLine) = 0));
end
else
begin
TSeries(Self.Items[SeriesInfo^[NoPastedSeries].Index]).ZData :=
SeriesInfo^[NoPastedSeries].Index;
end;
Inc(NoPastedSeries);
end
else
begin
SeriesInfo^[NoPastedSeries].XCol := -1;
end;
end;
{now we try to convert all the data:}
if (NoPastedSeries > 0) then
ParseData := ConvertTextData(ParserForm.InfoGrid.ColCount-1, NoPastedSeries, ParserForm.TheFirstDataLine,
Delimiter, TheData, SeriesInfo);
FreeMem(SeriesInfo, ParserForm.InfoGrid.ColCount * SizeOf(TSeriesInfo));
FreeMem(SeriesOfCol, ParserForm.InfoGrid.ColCount * SizeOf(Integer));
end; {No Z's on us !}
end; {ShowModal = mrOK}
ParserForm.Free;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.ConvertBinaryData
Description: Adds binary data to the new Series
Author: Mat Ballard
Date created: 12/1/1999
Date modified: 04/27/2001 by Mat Ballard
Purpose: Given a AxisLocationArray, converts the text data to numeric data and adds it to the new Axis
Return Value: TRUE is successful
Known Issues: This procedure assumes that TheStream.Position points to the start
of the binary data.
Moved from TCustomPlot.
------------------------------------------------------------------------------}
function TSeriesList.ConvertBinaryData(
ColCount,
SeriesCount: Integer;
TheStream: TMemoryStream;
SeriesInfo: pSeriesInfoArray): Boolean;
var
DataSize,
i: Integer; {iColumn}
MemPosition: Longint;
NullValue,
ZValue: Single;
ptr: Pointer;
pTheChar: PChar;
pValues: pSingleArray;
pLine: array [0..32] of char;
XTextValue: String;
begin
//ConvertBinaryData := FALSE;
GetMem(pValues, ColCount * SizeOf(Single));
DataSize := SizeOf(Single);
{calculate our "ignore" value:}
ptr := @NullValue;
pTheChar := ptr;
for i := 1 to DataSize do
begin
pTheChar^ := 'x';
Inc(pTheChar);
end;
{check fir ZData:}
MemPosition := TheStream.Position;
TheStream.Read(pLine, 6);
pLine[6] := Chr(0);
if (StrComp(pLine, 'ZData:') = 0) then
begin
for i := 0 to SeriesCount-1 do
begin
TheStream.Read(ZValue, DataSize);
TSeries(Self.Items[SeriesInfo^[i].Index]).ZData := ZValue;
end;
end
else
TheStream.Position := MemPosition;
while (TheStream.Position < TheStream.Size) do
begin
for i := 0 to SeriesCount-1 do
begin
if (SeriesInfo^[i].XCol > 0) then
TheStream.Read(SeriesInfo^[i].XValue, DataSize);
if (SeriesInfo^[i].XTextCol > 0) then
XTextValue := ReadLine(TheStream);
TheStream.Read(SeriesInfo^[i].YValue, DataSize);
if (SeriesInfo^[i].XTextCol > 0) then
TSeries(Self.Items[SeriesInfo^[i].Index]).AddStringPoint(
XTextValue,
SeriesInfo^[i].XValue,
SeriesInfo^[i].YValue,
FALSE, FALSE)
else
TSeries(Self.Items[SeriesInfo^[i].Index]).AddPoint(
SeriesInfo^[i].XValue,
SeriesInfo^[i].YValue,
FALSE, FALSE);
end; {for iColumn}
end; {for lines of data}
FreeMem(pValues, ColCount * SizeOf(Single));
{for a subsequent SaveClick:}
ConvertBinaryData := TRUE;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.ConvertTextData
Description: Adds text data to the new Series
Author: Mat Ballard
Date created: 12/1/1999
Date modified: 04/27/2001 by Mat Ballard
Purpose: Given a pSeriesInfoArray, converts the text data to numeric data and adds it to the new Axis
Return Value: TRUE is successful
Known Issues: moved from TCustomPlot
------------------------------------------------------------------------------}
function TSeriesList.ConvertTextData(
ColCount,
SeriesCount,
FirstLine: Integer;
Delimiter: String;
TheData: TStringList;
SeriesInfo: pSeriesInfoArray): Boolean;
var
i,
jRow: Integer;
TheCell,
TheLine: String;
TheSortedLine: TStringList;
begin
{Does this contain Z Data ?}
if (Pos('ZData', TheData.Strings[FirstLine]) > 0) then
begin
TheLine := TheData.Strings[0];
for i := 0 to SeriesCount-1 do
begin
if (SeriesInfo^[i].XCol > 0) then
GetWord(TheLine, Delimiter);
if (SeriesInfo^[i].XTextCol > 0) then
GetWord(TheLine, Delimiter);
TheCell := GetWord(TheLine, Delimiter);
TSeries(Self.Items[SeriesInfo^[i].Index]).ZData :=
StrToFloat(TheCell);
end;
Inc(FirstLine);
end;
TheSortedLine := TStringList.Create;
for i := 0 to ColCount-1 do
TheSortedLine.Add('');
for jRow := FirstLine to TheData.Count-1 do
begin
TheLine := TheData.Strings[jRow];
for i := 0 to ColCount-1 do
begin
TheSortedLine.Strings[i] := GetWord(TheLine, Delimiter);
end;
for i := 0 to SeriesCount-1 do
begin
try
if (SeriesInfo^[i].XCol = -2) then
SeriesInfo^[i].XValue := (jRow - FirstLine)
else if (SeriesInfo^[i].XCol > 0) then
SeriesInfo^[i].XValue := StrToFloat(TheSortedLine.Strings[SeriesInfo^[i].XCol-1]);
if (Length(TheSortedLine.Strings[SeriesInfo^[i].YCol-1]) > 0) then
begin
SeriesInfo^[i].YValue := StrToFloat(TheSortedLine.Strings[SeriesInfo^[i].YCol-1]);
if (SeriesInfo^[i].XTextCol > 0) then
TSeries(Self.Items[SeriesInfo^[i].Index]).AddStringPoint(
TheSortedLine.Strings[SeriesInfo^[i].XTextCol-1],
SeriesInfo^[i].XValue,
SeriesInfo^[i].YValue,
FALSE, FALSE)
else
TSeries(Self.Items[SeriesInfo^[i].Index]).AddPoint(
SeriesInfo^[i].XValue,
SeriesInfo^[i].YValue,
FALSE, FALSE);
end;
except
SeriesInfo^[i].XValue := -999999;
end;
end; {for i}
end; {for lines of data}
{cleanup:}
TheSortedLine.Free;
{Make the new Series visible:}
for i := 0 to SeriesCount-1 do
begin
if (SeriesInfo^[i].Index >= 0) then
TSeries(Self.Items[SeriesInfo^[i].Index]).Visible := TRUE;
end;
{for a subsequent SaveClick:}
ConvertTextData := TRUE;
end;
{------------------------------------------------------------------------------
Function: TSeriesList.ConvertXYZData
Description: Processes XYZ text data
Author: Mat Ballard
Date created: 04/19/2001
Date modified: 04/27/2001 by Mat Ballard
Purpose: data importation
Return Value: TRUE is successful
Known Issues: moved from TCustomPlot
------------------------------------------------------------------------------}
function TSeriesList.ConvertXYZData(
FirstLine: Integer;
Delimiter: String;
InfoGridRows: TStrings;
TheData: TStringList): Boolean;
var
iCol,
jRow,
NoXYZs: Integer;
TheCell, TheLine: String;
X, Y, Z: Single;
pSeries: TSeries;
begin
//ConvertXYZData := FALSE;
for jRow := FirstLine to TheData.Count-1 do
begin
TheLine := TheData[jRow];
NoXYZs := 0;
X := -999999;
Y := -999999;
Z := -999999;
for iCol := 1 to InfoGridRows.Count-1 do
begin
TheCell := GetWord(TheLine, Delimiter);
if (InfoGridRows.Strings[iCol] = 'X') then
begin
X := StrToFloat(TheCell);
Inc(NoXYZs);
end
else if (InfoGridRows.Strings[iCol] = 'Y') then
begin
Y := StrToFloat(TheCell);
Inc(NoXYZs);
end
else if (InfoGridRows.Strings[iCol] = 'Z') then
begin
Z := StrToFloat(TheCell);
Inc(NoXYZs);
end;
{test for a triple:}
if (NoXYZs = 3) then
begin
NoXYZs := 0;
pSeries := Self.GetSeriesOfZ(Z);
if (pSeries = nil) then
begin
pSeries := TSeries(Self.Items[Self.Add(-1)]);
pSeries.ZData := Z;
end;
pSeries.AddPoint(X, Y, FALSE, TRUE);
end;
end;
end;
ConvertXYZData := TRUE;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.StyleChange
Description: target of all of the TSeries(Items[i]) OnStyleChange events
Author: Mat Ballard
Date created: 03/07/2001
Date modified: 03/07/2001 by Mat Ballard
Purpose: responds to changes in style of the member series
Known Issues:
------------------------------------------------------------------------------}
procedure TSeriesList.StyleChange(
Sender: TObject);
begin
if (FIgnoreChanges) then exit;
DoStyleChange;
end;
{------------------------------------------------------------------------------
Procedure: TSeriesList.DataChange
Description: target of all of the TSeries(Items[i]) OnStyleChange events
Author: Mat Ballard
Date created: 03/07/2001
Date modified: 03/07/2001 by Mat Ballard
Purpose: responds to changes in data of the member series
Known Issues: get up to 3 screen re-draws
------------------------------------------------------------------------------}
procedure TSeriesList.DataChange(
Sender: TObject);
begin
if (IgnoreChanges) then exit;
DoDataChange;
end;
end.