⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sgr_mark.pas

📁 图形控件,画实时曲线,等操作方便
💻 PAS
字号:
unit sgr_mark;
{(c) S.P.Pod'yachev 1998-2001}
{ver. SGraph 2.4}
{***************************************************}
{ Example of marker for Tsp_xyPlot                  }
{ Tsp_LineMarker - infinite vertical or horizontal  }
{                  line on the plot field           }
{ Tsp_ImageMarker - image on the plot field,        }
{                   can be used as background map   }
{***************************************************}

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


Type

{*** Tsp_LineMarker ***}

//line oreintation
Tsp_LMOrientation=(loVertical, loHorizontal);

//infinite vertical or horizontal line on the plot field
Tsp_LineMarker=class(Tsp_PlotMarker)
protected
  fPen:TPen;
  fBrush:TBrush;
  fOX :double; //position
  fLO:Tsp_LMOrientation;
  procedure SetBrush(const V:TBrush);
  procedure SetPen(const V:TPen);
  procedure AttrChanged(V:TObject);
  procedure SetOX(const V:double);
  procedure SetLO(const V:Tsp_LMOrientation);
public
  constructor Create(AOwner:TComponent);override;
  destructor Destroy;override;
  procedure Draw; override;
published
  property Pen:TPen read fPen write SetPen;
  property Brush:TBrush read fBrush write SetBrush;
  property Position:double read fOX write SetOX;
  property Orientation :Tsp_LMOrientation read fLO write SetLO default loVertical;
  property Visible default True;
end;


{*** Tsp_ImageMarker ***}

//image on the plot field, can be used as map
Tsp_ImageMarker=class(Tsp_PlotMarker)
protected
  fOX, fOY, fRX, fRY:double; //position
  fStretch:boolean;
  fPicture:TPicture;
  procedure SetPicture(Value: TPicture);
  procedure AttrChanged(V:TObject);
  procedure SetStretch(V:boolean);
  procedure SetX(const V:double);
  procedure SetXR(const V:double);
  procedure SetY(const V:double);
  procedure SetYR(const V:double);
public
  constructor Create(AOwner:TComponent);override;
  destructor Destroy;override;
  procedure Draw; override;
published
  property Picture:TPicture read fPicture write SetPicture;
  property X:double read fOX write SetX;
  property Y:double read fOY write SetY;
  property Stretch:boolean read fStretch write SetStretch default False;
  property StretchX:double read fRX write SetXR;
  property StretchY:double read fRY write SetYR;
  property Visible default True;
end;


IMPLEMENTATION


{*** Tsp_LineMarker ***}

procedure Tsp_LineMarker.SetOX(const V:double);
begin
 if fOX<>V then begin
   fOX:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_LineMarker.SetLO(const V:Tsp_LMOrientation);
begin
 if fLO<>V then begin
   fLO:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_LineMarker.SetBrush(const V:TBrush);
begin
   fBrush.Assign(V);
end;

procedure Tsp_LineMarker.SetPen(const V:TPen);
begin
   fPen.Assign(V);
end;

procedure Tsp_LineMarker.AttrChanged(V:TObject);
begin
  mInvalidatePlot;
end;

constructor Tsp_LineMarker.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 fOX:=0; {fOY:=0;
 fRX:=1; fRY:=1;}
 fPen:=TPen.Create;
 fBrush:=TBrush.Create;
 fPen.OnChange:=AttrChanged;
 fBrush.OnChange:=AttrChanged;
 fVisible:=True;
end;

destructor Tsp_LineMarker.Destroy;
begin
 if Assigned(fPen) then begin
  fPen.OnChange:=nil;
  fPen.Free;
 end;
 if Assigned(fBrush) then begin
  fBrush.OnChange:=nil;
  fBrush.Free;
 end;
 inherited;
end;

procedure Tsp_LineMarker.Draw;
  procedure dVertLine;
  var p:integer;
  begin
    p:=XAxisObj.V2P(fOX);
    with Plot.DCanvas, Plot.FieldRect do begin
      if (p>Right+fPen.Width-1) or (p<Left-fPen.Width) then Exit;
      Pen.Assign(fPen);
      Brush.Assign(fBrush);
      MoveTo(p,Top);
      LineTo(p,Bottom);
   end;
  end;
  procedure dHorizLine;
  var p:integer;
  begin
    p:=YAxisObj.V2P(fOX);
    with Plot.DCanvas, Plot.FieldRect do begin
      if (p>Bottom+fPen.Width-1) or (p<Top-fPen.Width+1) then Exit;
      Pen.Assign(fPen);
      Brush.Assign(fBrush);
      MoveTo(Left,p);
      LineTo(Right,p);
   end;
  end;
begin   //Tsp_LineMarker.Draw;
 if Not(Assigned(Plot)) then Exit;
 if fLO=loVertical then dVertLine else dHorizLine;
end;


{*** Tsp_ImageMarker ***}

procedure Tsp_ImageMarker.SetPicture(Value: TPicture);
begin
 fPicture.Assign(Value);
end;

procedure Tsp_ImageMarker.AttrChanged(V:TObject);
begin
  mInvalidatePlot;
end;

procedure Tsp_ImageMarker.SetStretch(V:boolean);
begin
 if fStretch<>V then begin
   fStretch:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_ImageMarker.SetX(const V:double);
begin
 if fOX<>V then begin
   fOX:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_ImageMarker.SetXR(const V:double);
begin
 if fRX<>V then begin
   fRX:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_ImageMarker.SetY(const V:double);
begin
 if fOY<>V then begin
   fOY:=V; mInvalidatePlot;
 end;
end;

procedure Tsp_ImageMarker.SetYR(const V:double);
begin
 if fRY<>V then begin
   fRY:=V; mInvalidatePlot;
 end;
end;

constructor Tsp_ImageMarker.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 fOX:=0; fOY:=0;
 fRX:=1; fRY:=1;
 fPicture := TPicture.Create;
 fPicture.OnChange:=AttrChanged;
 fVisible:=True;
end;

destructor Tsp_ImageMarker.Destroy;
begin
 fPicture.Free;
 inherited;
end;

procedure Tsp_ImageMarker.Draw;
  procedure AlignInt(var t,b:integer); //swap if need
  var i:integer;
  begin
    if t>b then begin i:=t; t:=b; b:=i; end
  end;
  function GetDrawRect:TRect; //calc draw rect posion
  begin
   with Result do begin
     Top:=YAxisObj.V2P(fOY);
     Bottom:=YAxisObj.V2P(fRY);
     Left:=XAxisObj.V2P(fOX);
     Right:=XAxisObj.V2P(fRX);
     AlignInt(Top,Bottom);
     AlignInt(Left,Right);
   end;
  end;
  procedure dImage;
  var R,DR:TRect;
  begin
   with R do begin
     Top:=YAxisObj.V2P(fOY);
     Left:=XAxisObj.V2P(fOX);
     Bottom:=Top+fPicture.Height;
     Bottom:=Top+fPicture.Width;
   end;
   DR:=Plot.FieldRect;    //to do
   if IntersectRect(DR,R,DR) then with R do begin
      Plot.DCanvas.Draw(Left, Top, fPicture.Graphic);
   end;
  end;
  procedure dImageInRect;
  var R,DR:TRect;
  begin
   R:=GetDrawRect;
   DR:=Plot.FieldRect;    //to do
   if IntersectRect(DR,R,DR) then with DR do begin
      Plot.DCanvas.StretchDraw(R, fPicture.Graphic);
   end;
  end;
begin //Tsp_ImageMarker.Draw;
 if Not(Assigned(Plot)) then Exit;
 if fStretch then dImageInRect else dImage;
end;

END.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -