[rounin]

Pienso que mejor hacer objecto para toda esquema.
Aproximamante así:

Código Delphi [-]
 
unit Schem;
interface
uses
  Windows, Classes, Messages, Controls, Graphics, Contnrs,
  Fig, Elem;
type
  TCreateFigureFunc = function({?}): TFigure of object;
  TScheme = class(TCustomControl)
  private
    FRoot: TFigure;
    //FMouseCaptured: Boolean;
    FAddNewFigureMode: Boolean;
    FCreateNewFigureFunc: TCreateFigureFunc;
    procedure DrawGrid;
  protected
    function CreateRoot: TFigure; virtual; abstract;
  public
    property Root: TFigure read FRoot;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {----------------------}
    procedure Paint; override;
    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;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    {----------------------}
    procedure AddNewFigureNextClick(ACreateNewFigureFunc: TCreateFigureFunc);
    procedure AddFigure(Figure: TFigure); virtual;
  end;
implementation
uses SysUtils;
{---------------------------------- TScheme -----------------------------------}
constructor TScheme.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := True;
  ControlStyle := ControlStyle + [csOpaque];
  FRoot := CreateRoot;
end;
destructor TScheme.Destroy;
begin
  FRoot.Free;
  inherited;
end;
procedure TScheme.AddNewFigureNextClick(ACreateNewFigureFunc: TCreateFigureFunc);
begin
  FAddNewFigureMode := True;
  FCreateNewFigureFunc := ACreateNewFigureFunc;
end;
procedure TScheme.AddFigure(Figure: TFigure);
begin
  if FRoot is TFigureList then
    (FRoot as TFigureList).Add(Figure)
  else
    raise Exception.Create('You nee to override AddFigure');
end;
procedure TScheme.DrawGrid;
var i, j, H, W: Integer;
    R: TRect;
begin
  R := ClientRect;
  W := R.Right - R.Left;
  H := R.Bottom - R.Top;
  Canvas.Pen.Color := clBlack;
  for i := 0 to W div SNAP_SIZE do
    for j := 0 to H div SNAP_SIZE do
      Canvas.Pixels[i*SNAP_SIZE, j*SNAP_SIZE] := clBlack;
end;
procedure TScheme.Paint;
begin
  inherited;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Rectangle(ClientRect);
  DrawGrid;
  FRoot.DoDraw(Canvas);
end;
procedure TScheme.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  FRoot.DoKeyDown(Key, Shift);
  Invalidate;
end;
type
  THackFigure = class(TFigure);
procedure TScheme.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Handled: Boolean;
    NewFigure: TFigure;
    R: TRect;
begin
  inherited;
  Handled := False;
  if FAddNewFigureMode then
  begin
    if Assigned(FCreateNewFigureFunc) then
    begin
      NewFigure := FCreateNewFigureFunc;
      R := NewFigure.Rect;
      OffsetRect(R, X - R.Left, Y - R.Top);
      NewFigure.Rect := R;
      AddFigure(NewFigure);
    end;
    FAddNewFigureMode := False;
    Handled := True;
    THackFigure(FRoot).SetAgent(nil);
    Invalidate;
    Exit;
  end;
  FRoot.DoMouseDown(Button, Shift, X, Y, Handled);
  Invalidate;
end;
procedure TScheme.MouseMove(Shift: TShiftState; X, Y: Integer);
var cr: TCursor;
begin
  inherited;
  FRoot.DoMouseMove(Shift, X, Y, cr);
  Invalidate;
end;
procedure TScheme.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FRoot.DoMouseUp(Button, Shift, X, Y, {FMouseCaptured}GlobalMouseCaptured);
  Invalidate;
end;
end.
 
//--------------------------------------------------------------
 
unit main;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, 
  Fig, Elem, Schem;
type
  TBlockScheme = class;
  TForm1 = class(TForm)
    BNew2x2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure BNew2x2Click(Sender: TObject);
  private
    FScheme: TBlockScheme;
    FLast2x2Index: Integer;
  public
    function CreateBlock2x2: TFigure;
  end;
  TBlockScheme = class(TScheme)
  private
    function GetRoot: TBlockList;
  protected
    function CreateRoot: TFigure; override;
  public
    property Root: TBlockList read GetRoot;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
{---------------------------- TBlockScheme ------------------------------------}
function TBlockScheme.CreateRoot: TFigure;
begin
  Result := TBlockList.Create;
end;
function TBlockScheme.GetRoot: TBlockList;
begin
  Result := inherited Root as TBlockList;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
var bl: TBlock;
begin
  BNew2x2.GroupIndex := 1;
  BNew2x2.AllowAllUp := True;
  FScheme := TBlockScheme.Create(Self);
  FScheme.Parent := Self;
  FScheme.BoundsRect := Rect(30, 50, 650, 420);
end;
function TForm1.CreateBlock2x2: TFigure;
var bl: TBlock;
begin
  Inc(FLast2x2Index);
  bl := TBlock.Create;
  bl.Rect := Rect(420, 120, 480+1, 165+1);
  bl.Name := 'Test Block 3';
  TContact.Create(bl, ckInput);
  TContact.Create(bl, ckInput);
  TContact.Create(bl, ckOutput);
  TContact.Create(bl, ckOutput);
  bl.Name := 'Block 2x2 - ' + IntToStr(FLast2x2Index);
  Result := bl;
  BNew2x2.Down := False; 
end;
procedure TForm1.BNew2x2Click(Sender: TObject);
begin
  BNew2x2.Down := True;
  FScheme.AddNewFigureNextClick(CreateBlock2x2);
end;
end.