unit GraphicClasses;
interface
uses
  SysUtils, Classes, Graphics, ExtCtrls;
type
  TGraphicBase = class(TObject)
  private
    { Private declarations }
   frpoint:byte;
   fimage:TImage;
  protected
    { Protected declarations }
   procedure selectbox(x,y:integer);
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; virtual; abstract;
   procedure select(x,y:integer); overload; virtual; abstract;
   procedure move(x,y:integer);   virtual; abstract;
   procedure size(x,y:integer);   virtual; abstract;
   procedure redraw; virtual; abstract;
   procedure select; overload; virtual; abstract;
   procedure unselect; virtual; abstract;
  published
    { Published declarations }
   property refpoint:byte read frpoint write frpoint;
   property Image:TImage read fimage write fimage;
  end;
  TGraphicLine =class(TGraphicBase)
  private
    { Private declarations }
   fx1,fx2,fy1,fy2:integer;
   fcolor:TColor;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; override;
   procedure select(x,y:integer); override;
   procedure move(x,y:integer); override;
   procedure size(x,y:integer); override;
   procedure redraw; override;
   procedure select; override;
   procedure unselect; override;
  published
    { Published declarations }
   property x1:integer read fx1 write fx1;
   property y1:integer read fy1 write fy1;
   property x2:integer read fx2 write fx2;
   property y2:integer read fy2 write fy2;
   property color:TColor read fcolor write fcolor;
  end;
  TGraphicRect =class(TGraphicBase)
  private
    { Private declarations }
   fx1,fx2,fy1,fy2:integer;
   fcolor:TColor;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; override;
   procedure select(x,y:integer); override;
   procedure move(x,y:integer); override;
   procedure size(x,y:integer); override;
   procedure redraw; override;
   procedure select; override;
   procedure unselect; override;
  published
    { Published declarations }
   property x1:integer read fx1 write fx1;
   property y1:integer read fy1 write fy1;
   property x2:integer read fx2 write fx2;
   property y2:integer read fy2 write fy2;
   property color:TColor read fcolor write fcolor;
  end;
  TGraphicList=class(TObject)
  private
    { Private declarations }
    flist:TList;
    fimage:TImage;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create;
   function isobject(x,y:integer;var p:TGraphicBase; var j:integer):boolean;
   procedure add(u:TGraphicBase);
   procedure clear;
  published
    { Published declarations }
   property Image:TImage read fimage write fimage;
  end;
procedure Register;
implementation
const
 epsilon=4; //distance uncertainity
constructor TGraphicBase.create(image:TImage);
begin
 inherited create;
 fimage:=image;
end;
// black rectangle removes itself the second time
procedure TGraphicBase.selectbox(x,y:integer);
begin
 image.canvas.pen.color:=clwhite;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(x-2,y-2);
 image.Canvas.LineTo(x+2,y-2);
 image.Canvas.LineTo(x+2,y+2);
 image.Canvas.LineTo(x-2,y+2);
 image.Canvas.LineTo(x-2,y-2);
end;
//............................................................................
constructor TGraphicLine.create(image:TImage);
begin
 inherited create(image);
end;
// check start & end points
function TGraphicLine.isobject(x,y:integer):boolean;
begin
 result:=((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon));
end;
// check which corner is selected
procedure TGraphicLine.select(x,y:integer);
begin
 frpoint:=0;
 if ((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=1
 else begin
  if ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=2;
 end;
end;
// assumes the line is drawn - just move it
procedure TGraphicLine.move(x,y:integer);
begin
 image.canvas.pen.color:=clwhite xor fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  fx2:=fx2+(x-fx1);
  fy2:=fy2+(y-fy1);
  fx1:=x; fy1:=y;
 end;
 if frpoint=2 then begin
  fx1:=fx1+(x-fx2);
  fy1:=fy1+(y-fy2);
  fx2:=x; fy2:=y;
 end;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;
// move either point only
procedure TGraphicLine.size(x,y:integer);
begin
 image.canvas.pen.color:=clwhite xor fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  fx1:=x; fy1:=y;
 end;
 if frpoint=2 then begin
  fx2:=x; fy2:=y;
 end;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;
procedure TGraphicLine.redraw;
begin
 image.canvas.pen.color:=fcolor;
 image.Canvas.Pen.Mode:=pmCopy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;
procedure TGraphicLine.select;
begin
 selectbox(x1,y1);
 selectbox(x2,y2);
end;
procedure TGraphicLine.unselect;
begin
 selectbox(x1,y1);
 selectbox(x2,y2);
end;
//............................................................................
constructor TGraphicRect.create(image:TImage);
begin
 inherited create(image);
end;
//check all corners
function TGraphicRect.isobject(x,y:integer):boolean;
begin
 result:=((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon))or
         ((abs(x-fx1)< epsilon)and(abs(y-fy2)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy1)< epsilon));
end;
// check which corner is selected
procedure TGraphicRect.select(x,y:integer);
begin
 frpoint:=0;
 if ((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=1
 else
  if ((abs(x-fx2)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=2
  else
   if ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=3
   else
    if ((abs(x-fx1)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=4;
end;
// move all points
procedure TGraphicRect.move(x,y:integer);
var dx,dy:integer;
begin
 dx:=0; dy:=0;
 image.canvas.pen.color:=clwhite XOR fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  dx:=x-fx1; dy:=y-fy1;
 end;
 if frpoint=2 then begin
  dx:=x-fx2; dy:=y-fy1;
 end;
 if frpoint=3 then begin
  dx:=x-fx2; dy:=y-fy2;
 end;
 if frpoint=4 then begin
  dx:=x-fx1; dy:=y-fy2;
 end;
 fx1:=fx1+dx; fx2:=fx2+dx;
 fy1:=fy1+dy; fy2:=fy2+dy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;
// move one corner only
procedure TGraphicRect.size(x,y:integer);
var dx,dy:integer;
begin
 dx:=0; dy:=0;
 image.canvas.pen.color:=clwhite XOR fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  dx:=x-fx1; dy:=y-fy1;
  fx1:=fx1+dx;fy1:=fy1+dy;
 end;
 if frpoint=2 then begin
  dx:=x-fx2; dy:=y-fy1;
  fx2:=fx2+dx;fy1:=fy1+dy;
 end;
 if frpoint=3 then begin
  dx:=x-fx2; dy:=y-fy2;
  fx2:=fx2+dx; fy2:=fy2+dy;
 end;
 if frpoint=4 then begin
  dx:=x-fx1; dy:=y-fy2;
  fx1:=fx1+dx;fy2:=fy2+dy;
 end;
 //fx1:=fx1+dx; fx2:=fx2+dx;
 //fy1:=fy1+dy; fy2:=fy2+dy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;
procedure TGraphicRect.redraw;
begin
 image.canvas.pen.color:=fcolor;
 image.Canvas.Pen.Mode:=pmCopy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;
procedure TGraphicRect.select;
begin
 selectbox(x1,y1);
 selectbox(x2,y1);
 selectbox(x2,y2);
 selectbox(x1,y2);
end;
procedure TGraphicRect.unselect;
begin
 selectbox(x1,y1);
 selectbox(x2,y1);
 selectbox(x2,y2);
 selectbox(x1,y2);
end;
//............................................................................
constructor TGraphicList.create;
begin
 inherited create;
 flist:=TList.create;
end;
function TGraphicList.isobject(x,y:integer;var p:TGraphicBase; var j:integer):boolean;
var i:integer;
begin
 i:=0; result:=false;
 while (not result)and(i < (fList.count)) do begin
  p:=TGraphicBase(flist.items[i]);
  //if p is TGraphicLine
   if p.isobject(x,y) then result:=true
   else inc(i);
  end; // while
end;
procedure TGraphicList.add(u:TGraphicBase);
begin
 flist.add(u);
end;
procedure TGraphicList.clear;
var i:integer;
 p:TGraphicBase;
begin
 while flist.count>0 do begin
  p:=flist[flist.count-1];
  p.Destroy;
  end;
end;
//............................................................................
procedure Register;
begin
//  RegisterComponents('Samples', [TGraphicClasses]);
end;
end.