sgr_data.pas

图形控件,画实时曲线,等操作方便

unit sgr_data;
{(c) S.P.Pod'yachev 1998-2001}
{ver. 2.4 8.02.2001}
{***************************************************}
{ Example of series for Tsp_xyPlot                  }
{                                                   }
{***************************************************}

interface
uses
  Windows, SysUtils,  Classes,  Graphics,
  sgr_scale, sgr_def;

Type

{*** Tsp_XYDataSeries ***}

//ancestor of my data series
//has storage for x, y data and maintains main method & properties for it
Tsp_XYDataSeries=class(Tsp_DataSeries)
protected
  //canvas where draw
  fCanvas:TCanvas;
  //capacity & points number service
  fPN:integer;        //number of valid data elements (x,y points)
  fCapacity:integer;  //reserved memory in number of data elements
  fInc:integer;       //step of expand increment of allocated memory
  //
  XV: Variant;        //storage for X values
  YV: Variant;        //storage for Y values
  //Max Min service
  XMin,XMax,            //Min & Max of data
  YMin,YMax: double;
  ValidMinMax:boolean;  //used to minimise MinMax calculating
  //Draw attributes
  fLineAttr:Tsp_LineAttr; //line attribute
  //control service
  fLockInvalidate:boolean; //lock invalidate plot while data are changing

  //if can invalidate Plot then return True
  function CanPlot:boolean;
  //if it is possible then immediately redraw plot to reflect changes
  procedure TryUpdatePlot;
  //used in several procedures when data are added
  procedure TryUpdateMinMax(aX,aY:double);

  //increase allocated memory size by fInc
  procedure Expand;
  //increase allocated memory size by IncSize
  procedure ExpandBy(IncSize:integer);
  //find Min & Max of data of series;
  procedure FindMinMax;
  //stop invalidate or force invalidate plot
  procedure SetLockInvalidate(const V:boolean);
  //attributes change
  procedure SetLineAttr(const V:Tsp_LineAttr);
  procedure AtrributeChanged(V:TObject); virtual;

public //Tsp_XYDataSeries
  constructor Create(AOwner:TComponent); override;
  destructor Destroy; override;
  //next 4 functions must be implemented for any series
  function GetXMin(var V:double):boolean; override;
  function GetXMax(var V:double):boolean; override;
  function GetYMin(var V:double):boolean; override;
  function GetYMax(var V:double):boolean; override;
  //this one does not clear memory, only set Count=0 and update Plot,
  //use AdjustCapacity after Clear, or SetCapacity(0) instead of Clear to free memory
  procedure Clear;
  //set minimum Capacity for current Count
  procedure AdjustCapacity;
  //use it if you know how many elements data will have and don't want to loose
  //time on auto expand when add data. If series is not empty and C less then
  //Count of data elements they will be truncated to fit capacity
  procedure SetCapacity(C:integer);
  //add values at the end of series data and update Plot
  procedure AddXY(aX,aY:double);
  //used to add many values at the end of series data and update Plot
  //pX, pY must points to array of double, n - number of elements in arrays
  procedure AddXYArrays(pX,pY:pointer; n:integer);
  //insert values at index i, shift rest to end
  procedure InsertXY(i:integer; aX,aY:double);
  //replace values at index i
  procedure ReplaceXY(i:integer; aX,aY:double);
  //Delete values at index i
  procedure Delete(i:integer);
  //Delete values with indexes from fromi up to toi
  procedure DeleteRange(fromi, toi:integer);
  //current memory allocation for data elements (for example number of points)
  property Capacity:integer read fCapacity;
  //current number of valid data elements (for example number of points)
  property Count:integer read fPN;
  //lock invalidate plot while data are changing and then unlock it
  property LockInvalidate:boolean read fLockInvalidate write setLockInvalidate;
  //
  property Canvas:TCanvas read fCanvas write fCanvas;
published
  //if True then series is visible and taken into account in AutoMin & AutoMax
  property Active default True;
end;


{*** Type for series points drawing ***}

TPointKind=(ptRectangle, ptEllipse, ptDiamond, ptCross, ptCustom,
            ptTriangle, ptDownTriangle);

{*** Tsp_PointAttr ***}

//holds points markers properties
Tsp_PointAttr=class(TBrush)
private
  fPointType:TPointKind;
  fHSize,  fVSize :integer;  //even half of horiz. & vert. point size
  fHSize1, fVSize1:integer;  //odd half of horiz. & vert. point size
  fVisible: boolean;
  fBorderWidth:integer;
  fBorderColor:TColor;
protected
  procedure SetType(const V:TPointKind);
  procedure SetVisible(const V:boolean);
  procedure SetHSize(V:integer);
  procedure SetVSize(V:integer);
  function  GetHSize:integer;
  function  GetVSize:integer;
  procedure SetBorderWidth(V:integer);
  procedure SetBorderColor(const V:TColor);
public
  constructor Create;
  procedure SetPenAttr(const APen:TPen);
  procedure Assign(Source: TPersistent); override;
  property eHSize:integer read fHSize;
  property oHSize:integer read fHSize1;
  property eVSize:integer read fVSize;
  property oVSize:integer read fVSize1;
  //is points are drawn
published
  //kind of point
  property Kind:TPointKind read fPointType write SetType;
  //horizontal size of Point
  property HSize:integer read GetHSize write SetHSize default 5;
  //vertical size of Point
  property VSize:integer read GetVSize write SetVSize default 5;
  //is points are drawn
  property Visible:boolean read fVisible write SetVisible;
  //points border width (pen)
  property BorderWidth:integer read fBorderWidth write SetBorderWidth default 1;
  //points border color (pen)
  property BorderColor:TColor read fBorderColor write SetBorderColor default clBlack;
end;

//type of darw point procedure
TDrawPointProc=procedure (const x, y: Integer) of object;

Tsp_XYLine=class;

//event to draw custom points
TDrawCustomPointEvent=procedure
(const XYLine:Tsp_XYLine; const xv,yv :double; x, y: Integer) of object;

{*** Tsp_XYLine ***}

//draw data as points and/or chain of line segments
Tsp_XYLine=class(Tsp_XYDataSeries)
protected
  fPA:Tsp_PointAttr;
  fDLM:boolean; //DrawingLegendMarker
  DrawPointProc:TDrawPointProc;
  fOnDrawCustomPoint:TDrawCustomPointEvent;
  procedure SetPointAttr(const V:Tsp_PointAttr);
  procedure AtrributeChanged(V:TObject); override;
  procedure DrawRect(const x, y: Integer);
  procedure DrawEllipse(const x, y: Integer);
  procedure DrawDiamond(const x, y: Integer);
  procedure DrawCross(const x, y: Integer);
  procedure DrawTriangle(const x, y: Integer);
  procedure DrawDownTriangle(const x, y: Integer);
public
  constructor Create(AOwner:TComponent); override;
  destructor Destroy; override;
  //implements series draw procedure
  procedure Draw; override;
  //implements series draw marker procedure
  procedure DrawLegendMarker(const LCanvas:TCanvas; MR:TRect); override;
  //add values at end like AddXY, but don't spend time to update Plot, instead
  //simply draw next line segment, therefore AutoMin and AutoMax are ignored
  procedure QuickAddXY(aX,aY:double); virtual;
  //to access to data
  function GetX(i:integer):double;
  function GetY(i:integer):double;
  property DrawingLegendMarker:boolean read fDLM; //true when DrawLegendMarker
published
  //defines is draw & how lines segments between points
  property LineAttr:Tsp_LineAttr read fLineAttr write SetLineAttr;
  //defines is draw & how lines points marker
  property PointAttr:Tsp_PointAttr read fPA write SetPointAttr;
  //if assigned caled to draw point with Kind=ptCustom
  property OnDrawCustomPoint:TDrawCustomPointEvent read fOnDrawCustomPoint
                                                   write fOnDrawCustomPoint;
end;


{*** Tsp_SpectrLines ***}

Tsp_SpectrLines=class;

Tsp_YOrigin=(yoBaseLine, yoXAxises);

Tsp_WhatValues=(wvXValues, wvYValues);

Tsp_GetLabelEvent=procedure(Sender: Tsp_SpectrLines;
                         Num: integer;  //point number
                         X, Y : double; //points values
                         var LS:string) of object;   //label string

//draw data as bar with center at XV pos. and height from Bottom
//axis to YV or from BaseLine to YV;
Tsp_SpectrLines=class(Tsp_XYDataSeries)
private
  fBaseValue:double;
  fYOrigin:Tsp_YOrigin;
  fOnGetLabel: Tsp_GetLabelEvent; //customize label format handler
  fLabelFormat: string;       //format string for line label
  fLFont:TFont;               //label font
  fLVisible:boolean;          //is label visible
  fWhatValues:Tsp_WhatValues; //what values x or y use for label
  fBLVisible:boolean;         //is base line visible
  procedure SetBaseValue(V:double);
  procedure SetYOrigin(V:Tsp_YOrigin);
  procedure SetWhatValues(V:Tsp_WhatValues);
  procedure SetLabelFormat(const V:string);
  procedure SetLFont(V:TFont);
  procedure SetLVisible(const V:boolean);
  procedure SetBLVisible(const V:boolean);
public
  constructor Create(AOwner:TComponent); override;
  destructor Destroy; override;
  procedure Draw;override;
  function GetYMin(var V:double):boolean; override;
  function GetYMax(var V:double):boolean; override;
published
  //if YOrigin=yoBaseLine then lines begin from BaseValue
  property BaseYValue:double read fBaseValue write SetBaseValue;
  //define how lines are drawn
  property LineAttr:Tsp_LineAttr read fLineAttr write SetLineAttr;
  //if YOrigin=yoBaseLine then lines begin from BaseValue else from X Axis
  property YOrigin:Tsp_YOrigin read fYOrigin write SetYOrigin;
  //define X or Y values used in labels near spectral line
  property LabelValues:Tsp_WhatValues read fWhatValues write SetWhatValues;
  //format string to convert values to label text (template for FloatToStrF)
  property LabelFormat: string read fLabelFormat write SetLabelFormat;
  property LabelFont:TFont read fLFont write SetLFont;
  //show or not value label near line
  property ShowLabel:boolean read fLVisible write SetLVisible;
  //draw horizontal line at BaseYValue
  property ShowBaseLine:boolean read fBLVisible write SetBLVisible default True;
  //customize label format handler
  property OnGetLabel: Tsp_GetLabelEvent read fOnGetLabel write fOnGetLabel;
end;


IMPLEMENTATION

Type
 TDbls=array [0..MaxInt div 16] of double;
 pDbls= ^TDbls;
 TLP=array[0..MaxInt div 16] of TPoint;
 pLP= ^TLP;


{*** Tsp_XYDataSeries ***}

constructor Tsp_XYDataSeries.Create(AOwner:TComponent);
begin
 inherited Create(AOwner); 
 fInc:=32;
 XV:=VarArrayCreate([0, fInc], varDouble);
 YV:=VarArrayCreate([0, fInc], varDouble);
 fCapacity:=VarArrayHighBound(XV,1);
 fPN:=0;
 XMin:=5.0E-324; XMax:=1.7E308;
 YMin:=5.0E-324; YMax:=1.7E308;
 ValidMinMax:=False;
 fActive:=True;
 if csDesigning in ComponentState then
   while fPN<10 do AddXY(fPN, 1+2*(fPN mod 5)+Random(2));
 fLineAttr:=Tsp_LineAttr.Create;
 fLockInvalidate:=False;
 fLineAttr.OnChange:=AtrributeChanged;
end;

destructor Tsp_XYDataSeries.Destroy;
begin
 if Assigned(fLineAttr) then
 begin
   fLineAttr.OnChange:=nil;
   fLineAttr.Free
 end;
 inherited;
end;

function Tsp_XYDataSeries.CanPlot:boolean;
begin
 Result:=Not(fLockInvalidate) and Assigned(Plot);
end;

procedure Tsp_XYDataSeries.TryUpdatePlot;
begin
 if Not(fLockInvalidate) and Assigned(Plot) then
 begin
   InvalidatePlot(rsDataChanged);
   Plot.Update;                //call to redraw immediately
 end;
end;

procedure Tsp_XYDataSeries.TryUpdateMinMax(aX,aY:double);
begin
 if fPN=0 then begin
   XMin:=aX; XMax:=aX;
   YMin:=aY; YMax:=aY;
   ValidMinMax:=True;
 end
 else if ValidMinMax then begin
   if aX<XMin then XMin:=aX
   else if aX>XMax then XMax:=aX;
   if aY<YMin then YMin:=aY
   else if aY>YMax then YMax:=aY;
 end;
end;

procedure Tsp_XYDataSeries.Expand;
begin
 VarArrayRedim(XV, fCapacity+fInc);
 VarArrayRedim(YV, fCapacity+fInc);
 fCapacity:=VarArrayHighBound(XV,1);
end;

procedure Tsp_XYDataSeries.ExpandBy(IncSize:integer);
begin
 IncSize:=((IncSize div fInc)+1)*fInc;
 VarArrayRedim(XV, fCapacity+IncSize);
 VarArrayRedim(YV, fCapacity+IncSize);
 fCapacity:=VarArrayHighBound(XV,1);
end;

procedure Tsp_XYDataSeries.FindMinMax;
var pdX, pdY:pDbls; j:integer;
begin
 if fPN<1 then Exit;  //Exception
 pdX:=VarArrayLock(XV);
 pdY:=VarArrayLock(YV);
 try
  XMin:=pdX^[0]; XMax:=XMin;
  YMin:=pdY^[0]; YMax:=YMin;
  for j:=1 to fPN-1 do begin
    if pdX[j]<XMin then XMin:=pdX[j]
    else if pdX[j]>XMax then XMax:=pdX[j];
    if pdY[j]<YMin then YMin:=pdY[j]
    else if pdY[j]>YMax then YMax:=pdY[j];
  end;
  ValidMinMax:=True;
 finally
  VarArrayUnlock(YV);
  VarArrayUnlock(XV);
 end;
end;

procedure Tsp_XYDataSeries.SetLockInvalidate(const V:boolean);
begin
 if fLockInvalidate<>V then
 begin
   fLockInvalidate:=V;
   if CanPlot then InvalidatePlot(rsDataChanged)
 end;
end;

procedure Tsp_XYDataSeries.SetLineAttr(const V:Tsp_LineAttr);
begin
 if Not fLineAttr.IsSame(V) then begin
   fLineAttr.Assign(V);
 end;
end;

procedure Tsp_XYDataSeries.AtrributeChanged;
begin
 if CanPlot then InvalidatePlot(rsAttrChanged);
end;

//*******

function Tsp_XYDataSeries.GetXMin;
begin
 Result:=Count>0;
 if Result then
 begin