A component for creating graphs

Here is a component that draws graphs. You can zoom in and out of the graph.

The code is shown below. Copy the code to .pas file and install the component.

I will add a demo to show how to use this component soon.

----------------------------code-----------------------------------------------

unit UGraph;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Math;

type
  TOnMouseMove=procedure(Shift:TShiftState;x,y:integer) of object;
  TOnMouseDown=procedure(Button:TMouseButton;Shift:TShiftState;x,y:integer) of object;
  TOnMouseUp=procedure(Button:TMouseButton;Shift:TShiftState;x,y:integer) of object;

  TState=(fplotted,fjoined);
  TGraph = class;
  TPlots = class;

  TPoints =class(Tlist)
  private
   fplots:TPlots;
   fptcolor,fcrvcolor:TColor;
   fstate:set of Tstate;
   procedure fPlot;
   procedure fJoin;
  protected
   function Get(index:integer):PPoint;
  public
   procedure Plot;
   procedure Join;
   constructor Create(aplots:TPlots);
   function Add(x,y:integer):PPoint;
   procedure HideDots;
   procedure HideJoins;
   procedure Clear;override;
   property CurveColor:Tcolor read fcrvcolor write fcrvColor;
   property DotColor:Tcolor read fptcolor write fptColor;
   property Items[index:integer]:PPoint read Get;default;
  end;

  TPlots= class(Tlist)
  private
   fgraph:TGraph;
  protected
   function Get(index:integer):TPoints;
  public
   constructor Create(agraph:TGraph);
   function Add:TPoints;
   procedure Clear;override;
   procedure PlotAllDots;
   procedure PlotAllJoins;
   procedure HideAllDots;
   procedure HideAllJoins;
   property Items[index:integer]:TPoints read Get;default;
  end;

  TGraph = class(TGraphicControl)
   private
    faxcolor,fbkcolor,fgridcolor:Tcolor;
    fMouseDown:TOnMouseDown;
    fMouseMove:TOnMouseMove;
    fMouseUp:TOnMouseUp;
    fspc:extended;
    ldiv,sdiv:integer;
    xaxis,yaxis:integer;
    xlc,ylc:integer;
    fmag:integer;
    fplots:TPlots;
    function Translate(x,y:integer):Tpoint;
    function GetScale:Extended;
    procedure DrawGrid;
    procedure DrawAxes;
    procedure GetXLineRect(y:integer;var arect:trect);
    procedure GetYLineRect(x:integer;var arect:trect);
    procedure SetGridColor(acolor:Tcolor);
    procedure SetBackColor(acolor:Tcolor);
    procedure SetAxisColor(acolor:TColor);
  protected
    procedure loaded;override;
    procedure Paint; override;
    {procedure MsgHandler(var msg:TMessage);}
    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;
  public
    constructor Create(AComponent:TComponent);override;
    destructor Destroy;override;
    procedure OffSetAxes(x,y:integer);
    procedure ResetAxes;
    procedure Zoom(mag:integer);
    property Plots:TPlots read fplots;
  published
    property OnMouseDown:TOnMouseDown read fMouseDown write fMouseDown;
    property OnMouseMove:TOnMouseMove read fMouseMove write fMouseMove;
    property OnMouseUp:TOnMouseUp read fMouseUp write fMouseUp;
    property GridColor:Tcolor read fgridcolor write SetGridColor;
    property BackColor:Tcolor read fbkcolor write SetBackColor;
    property AxisColor:Tcolor read faxcolor write SetAxisColor;
    property Scale:extended read GetScale;
    property ZoomFactor:integer read fmag;
  end;

procedure Register;

implementation

procedure TGraph.MouseDown(Button:TMouseButton;shift:TShiftState;x,y:integer);
var
tp:Tpoint;
begin
tp.x:=x-left;
tp.y:=y-top;
tp.x:=trunc(tp.x/fspc-yaxis);
tp.y:=trunc(xaxis-tp.y/fspc);
if (assigned(fMouseDown)) then
  fMouseDown(button,shift,tp.x,tp.y);
inherited;
end;

procedure TGraph.MouseMove(shift:TShiftState;x,y:integer);
var
tp:Tpoint;
begin
tp.x:=x-left;
tp.y:=y-top;
tp.x:=trunc(tp.x/fspc-yaxis);
tp.y:=trunc(xaxis-tp.y/fspc);
if (assigned(fMousemove)) then
  fMousemove(shift,tp.x,tp.y);
inherited;
end;

procedure TGraph.MouseUp(Button:TMouseButton;shift:TShiftState;x,y:integer);
var
tp:Tpoint;
begin
tp.x:=x-left;
tp.y:=y-top;
tp.x:=trunc(tp.x/fspc-yaxis);
tp.y:=trunc(xaxis-tp.y/fspc);
if (assigned(fMouseUp)) then
  fMouseup(button,shift,tp.x,tp.y);
inherited;
end;

constructor TPoints.Create(aplots:TPlots);
begin
if aplots=nil then
  raise Exception.Create('Not a valid Graph object.');
fplots:=aplots;
end;

constructor TPlots.Create(agraph:Tgraph);
begin
if agraph=nil then
  raise Exception.Create('Not a valid Graph object.');
fgraph:=agraph;
end;

procedure TPoints.HideDots;
begin
fstate:=fstate-[fplotted];
end;

procedure TPoints.HideJoins;
begin
fstate:=fstate-[fjoined];
end;

procedure TPoints.Plot;
begin
fstate:=fstate+[fplotted];
fplots.fgraph.invalidate;
end;

procedure TPoints.fPlot;
var
i:integer;
tmp:tpoint;
begin
if count<=0 then
  exit;
with fplots.fgraph do
  begin
   canvas.pen.color:=fptcolor;
   canvas.pen.width:=1;
   for i:=0 to count-1 do
    begin
     tmp:=Translate(items[i].x,items[i].y);
     canvas.Ellipse(rect(tmp.x-1,tmp.y-1,tmp.x+1,tmp.y+1));
    end;
  end;
end;

procedure TPoints.Join;
begin
fstate:=fstate+[fjoined];
fplots.fgraph.invalidate;
end;

procedure TPoints.fJoin;
var
i:integer;
tmp:tpoint;
begin
if count<=0 then
  exit;
with fplots.fgraph do
  begin
   canvas.pen.color:=fcrvcolor;
   canvas.pen.width:=1;
   tmp:=Translate(items[0].x,items[0].y);
   canvas.moveto(tmp.x,tmp.y);
   for i:=1 to count-1 do
    begin
     tmp:=Translate(items[i].x,items[i].y);
     canvas.lineto(tmp.x,tmp.y);
    end;
  end;
end;

procedure TPlots.PlotAllDots;
var
i:integer;
begin
for i:= 0 to count -1 do
  items[i].Plot;
end;

procedure TPlots.PlotAllJoins;
var
i:integer;
begin
for i:= 0 to count -1 do
  items[i].join
end;

procedure TPlots.HideAllDots;
var
i:integer;
inv:boolean;
begin
inv:=false;
for i:= 0 to count -1 do
  if  (fplotted in items[i].fstate) then
   begin
    items[i].fstate:=items[i].fstate-[fplotted];
    inv:=true;
   end;
if inv then
  fgraph.invalidate;
end;

procedure TPlots.HideAllJoins;
var
i:integer;
inv:boolean;
begin
inv:=false;
for i:= 0 to count -1 do
  if  (fjoined in items[i].fstate) then
   begin
    items[i].fstate:=items[i].fstate-[fjoined];
    inv:=true;
   end;
if inv then
  fgraph.invalidate;
end;

function TPlots.Get(index:integer):TPoints;
begin
result:=TPoints(inherited Get(index));
end;

function TPlots.Add:TPoints;
begin
result:=TPoints.create(self);
inherited Add(result);
end;

procedure TPlots.Clear;
var
i:integer;
tmp:Tpoints;
begin
for i:=0 to count-1 do
  begin
   tmp:=items[i];
   freeandnil(tmp);
  end;
inherited;
end;

procedure TPoints.Clear;
var
i:integer;
begin
for i:=0 to count-1 do
  dispose(items[i]);
inherited;
end;

function TPoints.Get(index:integer):PPoint;
begin
result:=PPoint(inherited Get(index));
end;

function TPoints.Add(x,y:integer):PPoint;
begin
new(result);
result.x:=x;result.y:=y;
inherited Add(result);
end;

function TGraph.GetScale:extended;
begin
if fspc  result:=sdiv/fspc
else
  result:=1;
end;

destructor TGraph.Destroy;
begin
freeandnil(fplots);
inherited;
end;

constructor TGraph.Create(AComponent:TComponent);
begin
fplots:=TPlots.create(self);
fmag:=100;
fbkcolor:=clwhite;
faxcolor:=clnavy;
fgridcolor:=RGB(214,244,254);
ldiv:=10;sdiv:=5;fspc:=1;
inherited;
end;

procedure TGraph.GetXLineRect(y:integer;var arect:trect);
begin
arect.left:=left;arect.right:=arect.left+width;
arect.top:=top+trunc(y*fspc);
arect.bottom:=arect.top+2;
end;

procedure TGraph.GetYLineRect(x:integer;var arect:trect);
begin
arect.top:=top;arect.bottom:=arect.top+height;
arect.left:=left+trunc(x*fspc);
arect.right:=arect.left+2;
end;


procedure TGraph.SetGridColor(acolor:Tcolor);
begin
fgridcolor:=acolor;
Invalidate;
end;

procedure TGraph.SetBackColor(acolor:Tcolor);
begin
fbkcolor:=acolor;
Invalidate;
end;

procedure TGraph.SetAxisColor(acolor:TColor);
begin
faxcolor:=acolor;
Invalidate;
end;

procedure TGraph.Zoom(mag:integer);
begin
if mag<=0 then
  mag:=1;
if mag>100000 then
  mag:=100000;
fspc:=(mag/20);
if fspc>1 then
  fspc:=trunc(fspc);
fmag:=mag;
xlc:=Trunc(width/fspc);
ylc:=Trunc(height/fspc);
xaxis:=Trunc(ylc/2); yaxis:=Trunc(xlc/2);
Invalidate;
end;

function TGraph.Translate(x,y:integer):Tpoint;
begin
result.x:=trunc((x+yaxis)*fspc);
result.y:=trunc((xaxis-y)*fspc);
end;

procedure TGraph.loaded;
begin
Zoom(fmag);
end;

procedure TGraph.ResetAxes;
begin
Zoom(fmag);
end;

procedure TGraph.OffSetAxes(x,y:integer);
var
tmp:trect;
tmpx,tmpy:integer;
begin
canvas.Pen.color:=faxcolor;
canvas.Pen.Width:=1;
tmpx:=xaxis;tmpy:=yaxis;
xaxis:=xaxis-y;yaxis:=yaxis+x;
if (tmpx=xaxis) and (tmpy=yaxis) then
  exit;
GetXlineRect(tmpx,tmp);
InvalidateRect(parent.handle,@tmp,false);
GetYlineRect(tmpy,tmp);
InvalidateRect(parent.handle,@tmp,false);

GetXlineRect(xaxis,tmp);
InvalidateRect(parent.handle,@tmp,false);
GetYlineRect(yaxis,tmp);
InvalidateRect(parent.handle,@tmp,false);
end;

procedure TGraph.DrawAxes;
begin
canvas.Pen.color:=faxcolor;
canvas.Pen.Width:=1;
canvas.MoveTo(0,trunc(fspc*xaxis));
canvas.lineto(width,trunc(fspc*xaxis));
canvas.MoveTo(trunc(fspc*yaxis),0);
canvas.lineto(trunc(fspc*yaxis),height);
end;

procedure TGraph.DrawGrid;
var
i,t:integer;
t1,t2:Tpoint;
begin
i:=0;t:=0;
canvas.pen.color:=fbkcolor;
canvas.Brush.color:=fbkcolor;
canvas.rectangle(0,0,width,height);
canvas.Pen.color:=fgridcolor;
canvas.Pen.Width:=1;
while i<=width do
  begin
   if (t mod ldiv)=0 then
    canvas.pen.width:=2
   else
    canvas.pen.width:=1;
   t1.x:=i; t1.y:=0;
   canvas.moveto(t1.x,t1.y);
   t2.x:=i;t2.y:=height;
   canvas.lineto(t2.x,t2.y);
   i:=i+max(trunc(fspc),sdiv);
   t:=t+1;
  end;
i:=0;t:=0;
while i<=height do
  begin
   if (t mod ldiv)=0 then
    canvas.pen.width:=2
   else
    canvas.pen.width:=1;
   t1.x:=0; t1.y:=i;
   canvas.moveto(t1.x,t1.y);
   t2.x:=width;t2.y:=i;
   canvas.lineto(t2.x,t2.y);
   i:=i+max(trunc(fspc),sdiv);
   t:=t+1;
  end;
end;

procedure TGraph.Paint;
var
i:integer;
begin
DrawGrid;
for i:=0 to fplots.count-1 do
  begin
   if (fplotted in fplots[i].fstate) then
    fplots[i].fplot;
   if fjoined in fplots[i].fstate then
    fplots[i].fjoin;
  end;
DrawAxes;
end;

procedure Register;
begin
RegisterComponents('My Components', [TGraph]);
end;

end.
--------------------------------------------------------------------------------

Please report any bugs by adding comments to this article.