Simple Paint Application

type
 TMeta=class
  fForm:TForm;
  fForeColor:TColor;
  fBackColor:TColor;
  fTop:integer;
  fLeft:integer;
  fRight:integer;
  fBottom:integer;
  fSelected:boolean;
  constructor Create(AForm:TForm);
  procedure Colors(ForeColor,BackColor:TColor);
  procedure SelStart(x,y:integer);
  procedure SelEnd(x,y:integer);
  procedure MoveBy(x,y:integer);
  procedure Draw(Select:boolean); virtual;
  function Select(x,y:integer):boolean;
  function UnSelect:boolean;
  function HandleAt(x,y:integer):integer;
  procedure MouseMove(x,y:integer);
end;

private
    { Declarations privates }
    fMetas:TList;
    fFunction:integer;
    fMeta:TMeta;
    fDown:boolean;
    fDownX:integer;
    fDownY:integer;
    fMetaMove:integer;
    procedure FindMeta(x,y:integer);
    
Type
 TMetaLine=class(TMeta)
  procedure Draw(Select:boolean); override;
 end;

 TMetaTran=class(TMeta)
  fTransparent:boolean;
  Constructor Create(AForm:TForm;ATransparent:boolean);
 end;

 TMetaElps=class(TMetaTran)
  procedure Draw(Select:boolean); override;
 end;

 TMetaRect=class(TMetaTran)
  procedure Draw(Select:boolean); override;
 end;

const w=3;

//

Constructor TMeta.Create(AForm:TForm);
 begin
  fForm:=AForm;
  fForeColor:=clBlack;
  fBackColor:=clWhite;
  fTop:=0;
  fLeft:=0;
  fRight:=0;
  fBottom:=0;
  fSelected:=False;
end;

procedure TMeta.Draw(Select:boolean);
 var
  hmid,vmid:integer;
 begin
  if fSelected then with fForm.Canvas do begin
   Pen.Color:=clBlack;
   Pen.Style:=psDash;
   Brush.Style:=bsClear;
   Rectangle(fLeft,fTop,fRight,fBottom);
   Pen.Color:=clBlack;
   Pen.Style:=psSolid;
   Brush.Color:=clBlack;
   Brush.Style:=bsSolid;
   hmid:=fLeft+(fRight-fLeft) div 2;
   vmid:=fTop+(fBottom-fTop) div 2;
   Rectangle(fLeft-w,fTop-w,fLeft+w,fTop+w);
   Rectangle(fLeft-w,vMid-w,fLeft+w,vMid+w);
   Rectangle(fLeft-w,fBottom-w,fLeft+w,fBottom+w);
   Rectangle(hMid-w,fTop-w,hMid+w,fTop+w);
   Rectangle(fRight-w,fTop-w,fRight+w,fTop+w);
   Rectangle(fRight-w,vMid-w,fRight+w,vMid+w);
   Rectangle(fRight-w,fBottom-w,fRight+w,fBottom+w);
   Rectangle(hMid-w,fBottom-w,hMid+w,fBottom+w);
  end;
 end;

procedure TMeta.Colors(ForeColor,BackColor:TColor);
 begin
  fForeColor:=ForeColor;
  fBackColor:=BackColor;
 end;

Procedure TMeta.SelStart(x,y:integer);
 begin
  fLeft:=x;
  fTop:=y;
 end;

Procedure TMeta.SelEnd(x,y:integer);
 begin
  fRight:=x;
  fBottom:=y;
 end;

Procedure TMeta.MoveBy(x,y:integer);
 begin
  inc(fTop,y);
  inc(fLeft,x);
  inc(fRight,x);
  inc(fBottom,y);
 end;

function TMeta.Select(x,y:integer):boolean;
 begin
  fSelected:=(((x>=fLeft)and(x<=fRight)) or ((x<=fLeft)and(x>=fRight)))
          and(((y>=fTop)and(y<=fBottom)) or ((y<=fTop)and(y>=fBottom)));
  Result:=fSelected;
 end;

function TMeta.Unselect:boolean;
 begin
  Result:=fSelected;
  fSelected:=false;
 end;

function TMeta.HandleAt(x,y:integer):integer;
 var
  hmid,vmid:integer;
 begin
  Result:=-1;
  hmid:=fLeft+(fRight-fLeft) div 2;
  vmid:=fTop+(fBottom-fTop) div 2;
  if abs(fTop-y)<w then begin // top line
   if abs(fLeft-x)<w then Result:=0 else
   if abs(hmid-x)<w then Result:=1 else
   if abs(fRight-x)<w then result:=2;
  end else
  if abs(fRight-x)<w then begin // right line
   if abs(vmid-y)<w then result:=3 else
   if abs(fBottom-y)<w then result:=4;
  end else
  if abs(fBottom-y)<w then begin // bottom line
   if abs(hmid-x)<w then result:=5 else
   if abs(fLeft-x)<w then result:=6;
  end else
  if abs(fLeft-x)<w then begin // left line (last chance)
   if abs(hmid-y)<w then result:=7;
  end else
  if (((x>=fLeft)and(x<=fRight)) or ((x<=fLeft)and(x>=fRight)))
  and(((y>=fTop)and(y<=fBottom)) or ((y<=fTop)and(y>=fBottom))) then Result:=8;
 end;

Procedure TMeta.MouseMove(x,y:integer);
 begin
  if HandleAt(x,y)>=0 then fForm.Cursor:=crCross else fForm.Cursor:=crDefault;
 end;

Procedure TMetaLine.Draw(Select:boolean);
 begin
  with fForm.Canvas do begin
   if Select then begin
    Pen.Color:=clWhite;
    Pen.Mode:=pmXor;
   end else begin
    Pen.Color:=fForeColor;
    Pen.Mode:=pmCopy;
   end;
   Pen.Style:=psSolid;
   MoveTo(fLeft,fTop);
   LineTo(fRight,fBottom);
  end;
  inherited;
 end;

Constructor TMetaTran.Create(AForm:TForm;ATransparent:boolean);
 begin
  inherited Create(AForm);
  fTransparent:=ATransparent;
 end;

Procedure TMetaElps.Draw(Select:boolean);
 begin
  with fForm.Canvas do begin
   if Select then begin
    Pen.Color:=clWhite;
    Pen.Mode:=pmXor;
    Brush.Style:=bsClear;
   end else begin
    Pen.Color:=fForeColor;
    Pen.Mode:=pmCopy;
    if fTransparent then
     Brush.Style:=bsClear
    else begin
     Brush.Color:=fBackColor;
     Brush.Style:=bsSolid;
    end;
   end;
   Pen.Style:=psSolid;
   Ellipse(fLeft,fTop,fRight,fBottom);
  end;
  inherited;
 end;

Procedure TMetaRect.Draw(Select:boolean);
 begin
  with fForm.Canvas do begin
   if Select then begin
    Pen.Color:=clWhite;
    Pen.Mode:=pmXor;
    Brush.Style:=bsClear;
   end else begin
    Pen.Color:=fForeColor;
    Pen.Mode:=pmCopy;
    if fTransparent then
     Brush.Style:=bsClear
    else begin
     Brush.Color:=fBackColor;
     Brush.Style:=bsSolid;
    end;
   end;
   Pen.Style:=psSolid;
   Rectangle(fLeft,fTop,fRight,fBottom);
  end;
  inherited;
 end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 fMetas:=TList.Create;
 fFunction:=0;
 fMeta:=nil;
 fMetaMove:=-1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
 i:integer;
begin
 for i:=0 to fMetas.Count-1 do TMeta(fMetas[i]).Free;
 fMetas.Free;
end;

Procedure TForm1.FindMeta(x,y:integer);
 var
  i:integer;
 begin
  for i:=fMetas.Count-1 downto 0 do begin
   fMeta:=TMeta(fMetas[i]);
   if fMeta.Select(x,y) then begin
    Invalidate;
    exit;
   end;
  end;
  fMeta:=nil;
  invalidate;
 end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 fDownX:=x;
 fDownY:=y;

 if fFunction=0 then begin // select/modify
  if fMeta<>nil then begin // modify
   fMetaMove:=fMeta.HandleAt(x,y); // an handle ?
   if fMetaMove>=0 then exit;
   fMeta.UnSelect;
  end;
  FindMeta(x,y);
  exit;
 end;

 if fMeta<>nil then fMeta.UnSelect;
 fDown:=True;
 case fFunction of
  1:fMeta:=TMetaLine.Create(Self);
  2:fMeta:=TMetaElps.Create(Self,True);
  3:fMeta:=TMetaElps.Create(Self,False);
  4:fMeta:=TMetaRect.Create(Self,True);
  5:fMeta:=TMetaRect.Create(Self,False);
 end;
 fMeta.SelStart(x,y);
 fMeta.SelEnd(x,y);
 fMeta.Colors(ColorGrid.ForegroundColor,ColorGrid.BackgroundColor);
 fMeta.Select(x,y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if fDown then begin
  fMeta.Draw(True);
  fMeta.SelEnd(x,y);
  fMeta.Draw(True);
 end else begin
  if (fMeta<>nil)and(fMetaMove>=0) then begin
   fMeta.MouseMove(x,y);
   case fMetaMove of
    0:fMeta.SelStart(x,y);
    1:fMeta.fTop:=y;
    2:begin fMeta.fRight:=x; fMeta.fTop:=y; end;
    3:fMeta.fRight:=x;
    4:fMeta.SelEnd(x,y);
    5:fMeta.fBottom:=y;
    6:begin fMeta.fLeft:=x; fMeta.fBottom:=y; end;
    7:fMeta.fLeft:=x;
    8:begin
       fMeta.MoveBy(x-fDownX,y-fDownY);
       fDownX:=X;
       fDownY:=Y;
      end;
   end;
   invalidate;
  end;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if fDown then begin
  fDown:=false;
  SpeedButton1.Down:=True;
  fFunction:=0;
  fMeta.Draw(True);
  fMeta.SelEnd(x,y);
  fMetas.Add(fMeta);
  fMeta.Select(x,y);
  Invalidate;
 end;
 fMetaMove:=-1;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
 i:integer;
begin
 for i:=0 to fMetas.Count-1 do TMeta(fMetas[i]).Draw(False);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
 fFunction:=TSpeedButton(Sender).Tag;
end;

procedure TForm1.ColorGridChange(Sender: TObject);
begin
 if fMeta<>nil then begin
  fMeta.Colors(ColorGrid.ForegroundColor,ColorGrid.BackgroundColor);
  Invalidate;
 end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key=vk_delete then begin
  if (not fDown) and (fMeta<>nil) then begin
   fMetas.Remove(fMeta);
   fMeta.Free;
   fMeta:=nil;
   Invalidate;
  end;
 end;
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
var
 index:integer;
begin
 if fMeta<>nil then begin
  index:=fMetas.IndexOf(fMeta);
  if index<fMetas.Count-1 then begin
   fMetas.Move(index,index+1);
   invalidate;
  end;
 end;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
var
 index:integer;
begin
 if fMeta<>nil then begin
  index:=fMetas.IndexOf(fMeta);
  if Index>0 then begin
   fMetas.Move(index,index-1);
   Invalidate;
  end;
 end;
end;