fcurve.pas

很好地delphi书籍源码

unit FCurve;
  interface
  uses
    Windows, Messages, SysUtils,Classes,Graphics,Controls, Forms,
    Dialogs;
type
  TUserPlotFunc=procedure(X:real;var Y:Single) of object;
  TFunctionCurve = class(TGraphicControl)
   private
    { Private declarations }
    FRangeMinX:integer;
    FRangeMaxX:integer;
    FRangeMinY:integer;
    FRangeMaxY:integer;
    FUserFunc:TUserPlotFunc;
    protected
    procedure paint;override;
    public
{ Public declarations }
    constructor Create(AOwner:TComponent);override;
    published
    property RangeMinX:integer read FRangeMinX write FRangeMinX;
    property RangeMaxX:integer read FRangeMaxX write FRangeMaxX;
    property RangeMinY:integer read FRangeMinY write FRangeMinY;
    property RangeMaxY:integer read FRangeMaxY write FRangeMaxY;
    property OnUserFunc:TUserPlotFunc read FUserFunc write FUserFunc ;
    property Align ;
    property Width  default  400;
    property Height default 100;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
  end;

    procedure Register;

  implementation

constructor  TFunctionCurve.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Width :=200;
  Height:=100;
  FRangeMinX:=1;
  FRangeMinY:=1;
end;

procedure TFunctionCurve.Paint;
var
  X,Y:Integer;
  RX,RY:Single;
begin
  inherited Paint;
  Canvas.Rectangle(0,0,Width,Height);
  for X:=1 to Width do
  begin
    RX:=FRangeMinX+(((FRangeMaxX-FRangeMinX)/Width)*X);
    if Assigned(FUserFunc) then
      FUserFunc(RX,RY)
    else
      RY:=0;
    Y:=Round((1-((RY-FRangeMinY)/(FRangeMaxY-FRangeMinY)))*Height);
    if X=1 then
      Canvas.MoveTo(X,Y)
    else
      Canvas.LineTo(X,Y);
    end;
end;

procedure Register;
begin
  RegisterComponents('MyComponent', [TFunctionCurve]);
end;
end.