sgr_def.pas

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

unit sgr_def;
{(c) S.P.Pod'yachev 1998-1999 }
{ver. 2.3}
{*******************************************************}
{ here the base definition of SGraph                    }
{ Tsp_XYPlot - Plot itself which holds Axis as Tsp_Axis }
{ declaration Tsp_DataSeries - Plot Series ancestor     }
{ declaration Tsp_PlotMarker - Plot Marker ancestor     }
{*******************************************************}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, clipbrd, sgr_misc, sgr_scale;
Type
Tsp_XYPlot = class;
Tsp_Axis=class(Tsp_Scale)
private
  sMin, sMax : double;                                              
  fMargin: integer;                                                  
  fCaption: string;                           
  fDrawCaption: boolean;
  fPlot: Tsp_XYPlot;                         
  fGrid: Tsp_LineAttr;                            
  fMinMaxStored: boolean;                          
  procedure aInvalidatePlot;
  procedure SetMargin(const V:integer);
  procedure SetCaption(const V:string);
  procedure SetMin(const V:double);
  procedure SetMax(const V:double);
  procedure SetTicksCount(V:Byte);
  procedure SetLabelFormat(const V:string);
  procedure SetLineAttr(const V:Tsp_LineAttr);
  procedure LineChanged(V:TObject);
  procedure SetGrid(const V:Tsp_LineAttr);
  procedure GridChanged(V:TObject);
protected
  procedure FlagsChanged(const BN:integer; const On:boolean); override;
  procedure StoreMinMax;
  procedure ReStoreMinMax;
  function  TickLabel(tickNum:integer): string; override;
public
  constructor Create(Flags:integer);
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  procedure AssignTo(Dest: TPersistent); override;
  procedure SetMinMax(aMin,aMax:double);
  procedure MoveMinMax(aDelta:double);
published
  property Margin:integer read fMargin write SetMargin;
  property Caption:string read fCaption write SetCaption;
  property Min:double read fMin write SetMin stored False;
  property Max:double read fMax write SetMax stored False;
  property TicksCount: Byte read GetTicksCount write SetTicksCount default 5;
  property LineAttr:Tsp_LineAttr read fLineAttr write SetLineAttr;
  property GridAttr:Tsp_LineAttr read fGrid write SetGrid;
  property AutoMin:boolean index fbposAutoMin read GetFlagBit write SetFlagBit stored False;
  property AutoMax:boolean index fbposAutoMax read GetFlagBit write SetFlagBit stored False;
  property LabelAsDataTime:boolean index fbposLabelAsDate read GetFlagBit
                                   write SetFlagBit stored False;
  property LabelFormat: string read fLabelFormat write SetLabelFormat;
end;
Tsp_WhatXAxis=(dsxBottom, dsxTop);
Tsp_WhatYAxis=(dsyLeft,   dsyRight);
TIP_Reason=(rsDataChanged, rsAttrChanged);
Tsp_WhenDrawMarker=(dmBeforeSeries, dmAfterSeries);
Tsp_PlotMarker=class(TComponent)
protected
  fWhenDraw:Tsp_WhenDrawMarker;
  fVisible:boolean;
  fPlot: Tsp_XYPlot;                
  fWXA:Tsp_WhatXAxis;                                  
  fWYA:Tsp_WhatYAxis;                                  
  fXAx, fYAx:Tsp_Axis;
  procedure SetPlot(const Value: Tsp_XYPlot);                             
  procedure Notification(AComponent:TComponent; Operation:TOperation); override;
  procedure mInvalidatePlot;
  procedure SetWhenDraw(V:Tsp_WhenDrawMarker);
  procedure SetWXA(const V:Tsp_WhatXAxis);               
  procedure SetWYA(const V:Tsp_WhatYAxis);
  procedure SetVisible(const V:boolean);
public
  procedure BringToFront;
  procedure SendToBack;
  procedure Draw; virtual; abstract;
  property XAxisObj:Tsp_Axis read fXAx;
  property YAxisObj:Tsp_Axis read fYAx;
published
  property Plot: Tsp_XYPlot read fPlot write SetPlot;
  property XAxis:Tsp_WhatXAxis read fWXA write SetWXA default dsxBottom;
  property YAxis:Tsp_WhatYAxis read fWYA write SetWYA default dsyLeft;
  property WhenDraw:Tsp_WhenDrawMarker read fWhenDraw write SetWhenDraw;
  property Visible:boolean read fVisible write SetVisible;
end;
Tsp_DataSeries=class(TComponent)
protected
  fPlot: Tsp_XYPlot;                
  fWXA:Tsp_WhatXAxis;                                  
  fWYA:Tsp_WhatYAxis;                                  
  fActive:boolean;                                                            
  fLegend:string;
  procedure SetPlot(const Value: Tsp_XYPlot);                             
  procedure Notification(AComponent:TComponent; Operation:TOperation); override;
  procedure SetActive(const V:boolean);
  procedure SetWXA(const V:Tsp_WhatXAxis);               
  procedure SetWYA(const V:Tsp_WhatYAxis);
  procedure SetLegend(const V:string);
  procedure DoOnChange; virtual;
  procedure InvalidatePlot(const Reason:TIP_Reason);
public
  constructor Create(AOwner:TComponent); override;
  procedure Draw; virtual; abstract;
  function GetXMin(var V:double):boolean; virtual; abstract;
  function GetXMax(var V:double):boolean; virtual; abstract;
  function GetYMin(var V:double):boolean; virtual; abstract;
  function GetYMax(var V:double):boolean; virtual; abstract;
  procedure DrawLegendMarker(const LCanvas:TCanvas; MR:TRect); virtual;
  procedure BringToFront;
  procedure SendToBack;
  property Active:boolean read fActive write SetActive;
published
  property Plot: Tsp_XYPlot read fPlot write SetPlot;
  property XAxis:Tsp_WhatXAxis read fWXA write SetWXA default dsxBottom;
  property YAxis:Tsp_WhatYAxis read fWYA write SetWYA default dsyLeft;
  property Legend:string read fLegend write SetLegend;
end;
Tsp_BorderStyle=(bs_None, bs_Raised, bs_Lowered, bs_Gutter,
                 bs_BlackRect, bs_BoldRect, bs_FocusRect);
TGetTickLabelEvent=procedure(Sender: Tsp_Axis; LabelNum: integer;
                              LabelVal : double; var LS:string) of object;
Tsp_ShiftKeys=set of (ssShift, ssAlt, ssCtrl);
Tsp_zpDirections=(zpdNone, zpdHorizontal, zpdVertical, zpdBoth);
Tsp_ZoomData=record
  R:TRect;
  State:byte;          
end;
TZoomAxisEvent=procedure(Sender: Tsp_Axis; var min, max : double;
                                      var CanZoom:boolean) of object;
Tsp_XYPlot = class(TCustomControl)
private
  LA,RA,BA,TA: Tsp_Axis;             
  FR: TRect;                          
  fDCanvas: TCanvas;                              
  fDWidth,
  fDHeight: integer;                           
  fDDBBuf: Tsp_MemBitmap;                                
  fBuffered: boolean;                         
  VFont:TFont;                           
  fFieldDraw: TNotifyEvent;
  fDrawEnd: TNotifyEvent;
  fOnTickLabel: TGetTickLabelEvent;
  fOnZoom: TZoomAxisEvent;
  fFrameStyle: Tsp_BorderStyle;
  FBColor: TColor;                             
  fSeries: TList;                          
  fBSML,fASML:TList;                                
  fPanCursor:TCursor;
  fZoomEnabled, fPanEnabled : Tsp_zpDirections;
  fZoomShift: TShiftState;                                      
  fPanShift: TShiftState;                                      
  fZoomData: Tsp_ZoomData;                
  fXCursOn:boolean;                             
  fXCursVal:double;                     
  fXCursPos:integer;        
  procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  procedure CMFontChanged(var Message: TMessage); message CM_FontChanged;
  procedure CMSysColorChange(var Message: TMessage);  message CM_SysColorChange;
  procedure SysColorChange;
  procedure WMSize(var Message: TWMSize); message WM_SIZE;
  procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  procedure WMEraseBKGND(var Message: TWMERASEBKGND); message WM_ERASEBKGND;
  procedure SetLA(const V:Tsp_Axis);
  procedure SetRA(const V:Tsp_Axis);
  procedure SetBA(const V:Tsp_Axis);
  procedure SetTA(const V:Tsp_Axis);
  procedure FreshVFont;
  procedure SetFBColor(const V:TColor);
  procedure SetBorderStyle(const V: Tsp_BorderStyle);
  procedure SetBuffered(const V:boolean);
  procedure SetZoomShift(const V:Tsp_ShiftKeys);
  function  GetZoomShift:Tsp_ShiftKeys;
  procedure SetPanShift(const V:Tsp_ShiftKeys);
  function  GetPanShift:Tsp_ShiftKeys;
  function  GetSeriesPtr(i:integer):Tsp_DataSeries;
  function  GetSeriesCount:integer;
  procedure SetXCursOn(const V:boolean);
  procedure SetXCursVal(V:double);
  procedure DrawXCursor;
  procedure DrawXCursorOnPaint;
  procedure AddSeries(const DS:Tsp_DataSeries);
  procedure RemoveSeries(const DS:Tsp_DataSeries);
  function  MarkerList(const WDM:Tsp_WhenDrawMarker):TList;
  procedure RemoveMarker(const FM:Tsp_PlotMarker; const WDM:Tsp_WhenDrawMarker);
  procedure AddMarker(const FM:Tsp_PlotMarker; const WDM:Tsp_WhenDrawMarker);
  procedure SetMarkerAt(const FM:Tsp_PlotMarker; const WDM:Tsp_WhenDrawMarker; Front:boolean);
  procedure Arrange(AvgFntW,FntH:integer);
  function FindXAutoMin(WX:Tsp_WhatXAxis; var min:double ):boolean;
  function FindXAutoMax(WX:Tsp_WhatXAxis; var max:double ):boolean;
  function FindYAutoMin(WY:Tsp_WhatYAxis; var min:double ):boolean;
  function FindYAutoMax(WY:Tsp_WhatYAxis; var max:double ):boolean;
  function DoAutoMinMax(Axis:Tsp_Axis):boolean;
  procedure RectToLimits(ZR:TRect; D:Tsp_zpDirections);
  function LimitsStored:boolean;
  procedure StoreLimits;
  procedure RestoreLimits;
protected
  ValidArrange:boolean;
  ValidField:boolean;
  ValidAround:boolean;
  procedure CreateParams(var Params: TCreateParams); override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                                                X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                                                X, Y: Integer); override;
  procedure DrawAroundField;
  procedure DrawBorder;
  procedure DrawField;
  procedure DrawNotRect(R:TRect);
  procedure CustomInvalidate(Arrange, Around, Field :boolean);
  procedure InvalidateSeries(DS:Tsp_DataSeries);
  procedure pDrawPlot;
  procedure DoOnDrawEnd; virtual;
  procedure DoOnFieldDraw; virtual;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Invalidate; override;
  procedure BufferIsInvalid;
  procedure DrawPlot(DC:TCanvas; W, H:integer);
  procedure Paint; override;
  procedure CopyToClipboardMetafile;
  procedure CopyToClipboardBitmap;
  property DCanvas:TCanvas read fDCanvas;
  property DWidth:integer read fDWidth;
  property DHeight:integer read fDHeight;
  property FieldRect:TRect read FR;
  property Series[i:integer]:Tsp_DataSeries read GetSeriesPtr;
  property SeriesCount:integer read GetSeriesCount;
published
  property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Color;                                 
    property Ctl3D;
    property Font;                                        
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
   property OnStartDrag;
  property Zoom: Tsp_zpDirections read fZoomEnabled write fZoomEnabled default zpdBoth;
  property Pan: Tsp_zpDirections read fPanEnabled write fPanEnabled default zpdBoth;
  property ZoomShiftKeys : Tsp_ShiftKeys read GetZoomShift write SetZoomShift default [ssShift];
  property PanShiftKeys : Tsp_ShiftKeys read GetPanShift write SetPanShift default [ssCtrl];
  property PanCursor:TCursor read fPanCursor write fPanCursor default crDefault;
  property LeftAxis:Tsp_Axis read LA write SetLA;
  property RightAxis:Tsp_Axis read RA write SetRA;
  property BottomAxis:Tsp_Axis read BA write SetBA;
  property TopAxis:Tsp_Axis read TA write SetTA;
  property BorderStyle:Tsp_BorderStyle  read FFrameStyle write SetBorderStyle;
  property FieldColor:TColor read FBColor write SetFBColor;
  property BufferedDisplay:Boolean read fBuffered write SetBuffered default False;
  property XCursorOn:boolean read fXCursOn write SetXCursOn default False;
  property XCursorVal:double read fXCursVal write SetXCursVal;
  property OnAxisZoom: TZoomAxisEvent read fOnZoom write fOnZoom;
  property OnGetTickLabel:TGetTickLabelEvent read fOnTickLabel write fOnTickLabel;
  property OnFieldDraw:TNotifyEvent read fFieldDraw write fFieldDraw;
  property OnDrawEnd:TNotifyEvent read fDrawEnd write fDrawEnd;
end;
IMPLEMENTATION
constructor Tsp_Axis.Create(Flags:integer);
begin
 Inherited Create(Flags);
 fGrid:=Tsp_LineAttr.Create;
 fGrid.Color:=clGray;
 fGrid.Visible:=False;
 fMargin:=4;
 fCaption:='';
 fDrawCaption:=False;
 fPlot:=nil;
 fMinMaxStored:=False;
 fGrid.OnChange:=GridChanged;
 fLineAttr.OnChange:=LineChanged;
end;
destructor Tsp_Axis.Destroy;
begin
 fGrid.OnChange:=nil;
 fLineAttr.OnChange:=nil;
 if Assigned(fGrid) then fGrid.Free;
 inherited Destroy;
end;
procedure Tsp_Axis.aInvalidatePlot;
begin
 if Assigned(fPlot) then with fPlot do begin
   Invalidate;
  end;
end;
procedure Tsp_Axis.SetMargin(const V:integer);
begin
 if V<>fMargin then begin
  fMargin:=V;
  aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetCaption(const V:string);
var j:integer;
begin
 if V<>fCaption then begin
  fCaption:=V;
  fDrawCaption:=False;
  for j:=1 to length(fCaption) do if fCaption[j]>' ' then
  begin fDrawCaption:=True; break end;
  aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetMin(const V:double);
begin
 fFlags:=fFlags and Not(sdfAutoMin);
 fMinMaxStored:=False;
 if V<>fMin then begin
  ChangeMinMax(V, fMax);
  aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetMax(const V:double);
begin
 fFlags:=fFlags and Not(sdfAutoMax);
 fMinMaxStored:=False;
 if V<>fMax then begin
  ChangeMinMax(fMin, V);
  aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetTicksCount(V:Byte);
begin
 if V>MaxTicksCount then V:=MaxTicksCount;
 if V<>fTicksCount then begin
   fTicksCount:=V;
   CalcTicksVal;
   CalcTicksPos;
   aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetLabelFormat(const V:string);
begin
 if fLabelFormat<>V then
 begin
  fLabelFormat:=V;
  aInvalidatePlot;
 end;
end;
procedure Tsp_Axis.SetLineAttr(const V:Tsp_LineAttr);
begin
 if Not fLineAttr.IsSame(V) then fLineAttr.Assign(V);
end;
procedure Tsp_Axis.LineChanged(V:TObject);
begin
 aInvalidatePlot;
end;
procedure Tsp_Axis.SetGrid(const V:Tsp_LineAttr);
begin
 if Not fGrid.IsSame(V) then fGrid.Assign(V);
end;
procedure Tsp_Axis.GridChanged(V:TObject);
begin
 if Assigned(fPlot) then with fPlot do
 begin
   CustomInvalidate(False, False, True);
 end;
end;
procedure Tsp_Axis.FlagsChanged(const BN:integer; const On:boolean);
begin
  case BN of
  fbposInversed: begin
                  CalcMetr;
                  CalcTicksVal;
                  CalcTicksPos;
                  aInvalidatePlot;
                 end;
  fbposNoTicks,
  fbposNoTicksLabel,
  fbposNotAjustedTicks : begin
                  CalcTicksVal;
                  CalcTicksPos;
                  aInvalidatePlot;
                 end;
  fbposAutoMax,