////////////////////
unit mkkClassPlacer;

interface
uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, contnrs;

type
  EmkkException = class(Exception)
  end;{TmkkException}
  {TmkkControlClass}
  TmkkControlClass = class of TWinControl;

  {TmkkOnErrorEvent}
  TmkkErrorEvent = procedure(Sender: TObject; AClass: TmkkControlClass; AError: EmkkException; var ADoAbort: boolean) of object;

  TmkkPlacerChangeEvent = procedure (NewControl, OldControl: TWinControl) of object;
  {TmkkClassStack}
  TmkkClassStack = class(TClassList)
    function Pop: TClass;
    function Push(AClass: TClass): Integer;
    function IsEmpty: Boolean;
    function Peek: TClass;
  end;{TmkkClassStack}

  {TmkkClassPlacer}
  TmkkClassPlacer = class(TCustomPanel)
  private
    FIncludeList: boolean;
    FAlignClass: TAlign;
    FBackClasses: TmkkClassStack;
    FNextClasses: TmkkClassStack;
    FInplaceClass: TmkkControlClass;
    FInplaceControl: TWinControl;
    FRemoveFormBorders: Boolean;
    FOnError: TmkkErrorEvent;
    FOnAfterChange: TNotifyEvent;
    FOnBeforeChange: TNotifyEvent;
    FOnPlacerChange: TmkkPlacerChangeEvent;
    function GetEnableBack: Boolean;
    function GetEnableNext: Boolean;
    procedure SetAlignClass(const Value: TAlign);
    procedure SetIncludeList(const Value: boolean);
    procedure SetInplaceClass(const Value: TmkkControlClass);

  protected
    property BackClasses: TmkkClassStack
      read FBackClasses;

    property NextClasses: TmkkClassStack
      read FNextClasses;
    procedure AfterChange; virtual;
    procedure BeforeChange; virtual;
    procedure DoError(AClass: TmkkControlClass; AException: EmkkException; var ADoAbort: Boolean); virtual;
    procedure DoPlacerChange(NewControl, OldControl: TWinControl); virtual;
  public

    property EnableBack: Boolean
      read GetEnableBack;

    property EnableNext: Boolean
      read GetEnableNext;

    procedure Next; virtual;
    procedure Back; virtual;
    procedure ClearNext;
    procedure ClearBack;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Align;
    property Constraints;
    property AlignClass: TAlign
      read FAlignClass
      write SetAlignClass default alClient;
    property BorderStyle;
    property BevelInner;
    property BevelOuter;
    property BorderWidth;
    property BevelWidth;
    property Color;
    property Caption;
    property Enabled;
    property ShowHint;
    property Hint;
    property ParentShowHint;
    property ParentColor;
    property Font;
    property InplaceClass: TmkkControlClass
      read FInplaceClass
      write SetInplaceClass default nil;

    property InplaceControl: TWinControl
      read FInplaceControl default nil;

    property IncludeInList: boolean
      read FIncludeList
      write SetIncludeList default False;

    property RemoveFormBorders: Boolean
      read FRemoveFormBorders
      write FRemoveFormBorders default True;

    property OnAfterChange: TNotifyEvent
      read FOnAfterChange
      write FOnAfterChange default nil;

    property OnBeforeChange: TNotifyEvent
      read FOnBeforeChange
      write FOnBeforeChange default nil;

    property OnError: TmkkErrorEvent
      read FOnError
      write FOnError default nil;

    property OnPlacerChange: TmkkPlacerChangeEvent
      read FOnPlacerChange
      write FOnPlacerChange default nil;

    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;{TmkkClassPlacer}

procedure Register;

implementation
uses mkkConsts;
procedure StackAlreadyEmpty;
begin
  raise EmkkException.Create(serrStackEmpty);
end;{StackAlreadyEmpty}

procedure Register;
begin
  RegisterComponents('Mkk', [TmkkClassPlacer]);
end;

{ TmkkClassStack }

function TmkkClassStack.IsEmpty: Boolean;
begin
  Result := Count = 0;
end;

function TmkkClassStack.Peek: TClass;
begin
  Result := nil;
  if not IsEmpty then
    Result := Items[(Count-1)]; 
end;

function TmkkClassStack.Pop: TClass;
var
  liIndex: Integer;
begin
  Result := nil;
  if IsEmpty then
    StackAlreadyEmpty;
  liIndex:= Count-1;
  Result := Items[liIndex];
  Delete(liIndex);
end;

function TmkkClassStack.Push(AClass: TClass): Integer;
begin
  Result := Add(AClass);
end;
{ TmkkClassPlacer }

procedure TmkkClassPlacer.Back;
var
  Value: TmkkControlClass;
  OldClass :TmkkControlClass;
  OldControl: TWinControl;
  NewClass: TmkkControlClass;
  NewControl: TWinControl;
  DoAbort: Boolean;
begin
  if not EnableBack then Exit;
  NewClass := nil;
  NewControl := nil;
  Value := TmkkControlClass(FBackClasses.Pop);
  if FInplaceClass <> Value then
  begin
    //FInplaceClass := Value;
    OldClass := FInplaceClass;
    OldControl := FInplaceControl;
    if Assigned(Value) then
    begin
      BeforeChange;
      try
        NewControl := Value.Create(Self);
        NewControl.Parent := self;
        NewControl.Align := AlignClass;
        if (NewControl is TCustomForm) and (FRemoveFormBorders)then
          (NewControl as TCustomForm).BorderStyle := bsNone;
        NewControl.Visible := True;
      except
        on E: Exception do
        begin
          DoAbort := True;
          DoError(Value, (E as EmkkException), DoAbort);
          if DoAbort then raise;
        end;{on .. do}
      end;{try .. except}
      DoPlacerChange(NewControl, OldControl);
      FInplaceControl.Free;
      FInplaceControl := NewControl;
      FInplaceClass := Value;
      if FIncludeList then
      begin
        if Assigned(OldClass) then
        begin
          FNextClasses.Push(OldClass);
        end;{if .. then}
      end;{if .. then}
      AfterChange;
    end{if .. then}
  end;
end;


procedure TmkkClassPlacer.ClearBack;
begin
  FBackClasses.Clear;
end;

procedure TmkkClassPlacer.ClearNext;
begin
  FNextClasses.Clear;
end;

constructor TmkkClassPlacer.Create(AOwner: TComponent);
begin
  inherited;
  FRemoveFormBorders := True;
  FBackClasses := TmkkClassStack.Create;
  FNextClasses := TmkkClassStack.Create;
  FInplaceClass := nil;
  FInplaceControl := nil;
  IncludeInList := False;
  FAlignClass := alClient;
  FOnBeforeChange := nil;
  FOnAfterChange := nil;
  FOnError := nil;
  FOnPlacerChange := nil;
end;

destructor TmkkClassPlacer.Destroy;
begin
  InplaceClass := nil;
  FOnBeforeChange := nil;
  FOnAfterChange := nil;
  FOnError := nil;
  FBackClasses.Free;
  FNextCLasses.Free;
  inherited;
end;

procedure TmkkClassPlacer.BeforeChange;
begin
  if Assigned(FOnBeforeChange) then
    FOnBeforeChange(self);
end;

procedure TmkkClassPlacer.DoError;
begin
  if Assigned(FOnError) then
    FOnError(self, AClass, AException, ADoAbort);
end;

function TmkkClassPlacer.GetEnableBack: Boolean;
begin
  Result := FBackClasses.Count <> 0;
end;

function TmkkClassPlacer.GetEnableNext: Boolean;
begin
  Result := FNextClasses.Count <> 0;
end;

procedure TmkkClassPlacer.Next;
var
  Value: TmkkControlClass;
  OldClass :TmkkControlClass;
  OldControl: TWinControl;
  NewClass: TmkkControlClass;
  NewControl: TWinControl;
  DoAbort: boolean;
begin
  if not EnableNext then Exit;
  NewClass := nil;
  NewControl := nil;
  Value := TmkkControlClass(FNextClasses.Pop);
  if FInplaceClass <> Value then
  begin
    //FInplaceClass := Value;
    OldClass := FInplaceClass;
    OldControl := FInplaceControl;
    if Assigned(Value) then
    begin
      BeforeChange;
      try
        NewControl := Value.Create(Self);
        NewControl.Parent := self;
        NewControl.Align := AlignClass;
        if (NewControl is TCustomForm) and (FRemoveFormBorders)then
             (NewControl as TCustomForm).BorderStyle := bsNone;
        NewControl.Visible := True;
      except
        on E: Exception do
        begin
          DoAbort := True;
          DoError(Value, (E as EmkkException), DoAbort);
          if DoAbort then raise;
        end;{on .. do}
      end;{try .. except}
      DoPlacerChange(NewControl, OldControl);
      FInplaceControl.Free;
      FInplaceControl := NewControl;
      FInplaceClass := Value;
      if FIncludeList then
      begin
        if Assigned(OldClass) then
        begin
          FBackClasses.Push(OldClass);
        end;{if .. then}
      end;{if .. then}
      AfterChange;
    end{if .. then}
  end;
end;


procedure TmkkClassPlacer.SetAlignClass(const Value: TAlign);
begin
  if FAlignClass <> Value then
  begin
    FAlignClass := Value;
    if Assigned(FInplaceControl) then
      FInplaceControl.Align := Value;
  end;{if .. then}
end;

procedure TmkkClassPlacer.SetIncludeList(const Value: boolean);
begin
  if FIncludeList <> Value then
    FIncludeList := Value;
end;

procedure TmkkClassPlacer.SetInplaceClass(const Value: TmkkControlClass);
var
  OldClass :TmkkControlClass;
  OldControl: TWinControl;
  NewClass: TmkkControlClass;
  NewControl: TWinControl;
  DoAbort: Boolean;
begin
  NewClass := nil;
  NewControl := nil;

  if FInplaceClass <> Value then
  begin
    //FInplaceClass := Value;
    OldClass := FInplaceClass;
    OldControl := FInplaceControl;
    BeforeChange;
    if Assigned(Value) then
    begin
      try
        NewControl := Value.Create(Self);
        NewControl.Parent := self;
        NewControl.Align := AlignClass;
        if (NewControl is TCustomForm) and (FRemoveFormBorders)then
             (NewControl as TCustomForm).BorderStyle := bsNone;
        NewControl.SendToBack;
        NewControl.Visible := True;
      except
        on E: Exception do
        begin
          DoAbort := True;
          DoError(Value, (E as EmkkException), DoAbort);
          if DoAbort then raise;
        end;{on .. do}
      end;{try .. except}
      DoPlacerChange(NewControl, OldControl);
      FInplaceControl.Free;
      FInplaceControl := NewControl;
      FInplaceClass := Value;
      FNextClasses.Clear;
      if FIncludeList then
      begin
        if Assigned(OldClass) then
        begin
          FBackClasses.Push(OldClass);
        end;{if .. then}
      end;{if .. then}
      NewControl.BringToFront;
      AfterChange;
    end{if .. then}
  end;
end;

procedure TmkkClassPlacer.AfterChange;
begin
  if Assigned(FOnAfterChange) then
    FOnAfterChange(self);
end;

procedure TmkkClassPlacer.DoPlacerChange(NewControl,
  OldControl: TWinControl);
begin
  if Assigned(FOnPlacerChange) then
    FOnPlacerChange(NewControl, OldControl);
end;

end.
/////////////

Устанавливаем сию хрень в палитру.

Пример использования
Кидаем на форму TmkkClassPlacer — получаем область в которой будут отображаться формы или фреймы.
Создаем формы которые надо отображать кидаем на них компоненты, убираем из списка Auto-Create Forms. Подключаем модули с формами к модулю с TmkkClassPlacer.

Для того чтобы отобразить нужную форму используем следующее
mkkClassPlacer1.InplaceClass := <класс формы>
например
mkkClassPlacer1.InplaceClass := TForm1; — создает отображает форму Form1
.....
mkkClassPlacer1.InplaceClass := TForm2;- создает отображает форму Form2

.....
mkkClassPlacer1.InplaceClass := nil; — удаляет текущую созданую форму

через mkkClassPlacer1.InplaceControl — получаем доступ к созданой форме.
........
Если необходимо сохранять состояние формы, то лучьше воспользоватся TMergeManager из RxLib
Если нужен пример мыльте