UFormBlender.pas

unit UFormBlender;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TFormBlender = class(TForm)
    Temporizador: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure TemporizadorTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FInternalForm: TFormClass;
  public
    { Public declarations }
    class function ShowMe(AOwner: TForm; AInternalForm: TFormClass): TModalResult;
  end;

implementation

{$R *.dfm}

procedure TFormBlender.FormCreate(Sender: TObject);
var
  HOffset: Word;
  VOffset: Word;
begin
  // Isso vai falhar de acordo com o tipo de janela ter ou não uma borda
  // redimensionável. Mas isso é só um exemplo! Corra atrás de saber o que é
  // GetSystemMetrics, SM_CXSIZEFRAME, SM_CXBORDER, SM_CYSIZEFRAME e SM_CYBORDER
  HOffset := GetSystemMetrics(SM_CXSIZEFRAME) - GetSystemMetrics(SM_CXBORDER);
  VOffset := GetSystemMetrics(SM_CYSIZEFRAME) - GetSystemMetrics(SM_CYBORDER);

  Top := TForm(Owner).Top;
  Left := TForm(Owner).Left + HOffset;
  Height := TForm(Owner).Height - VOffset;
  Width := TForm(Owner).Width - 2 * HOffset;;
end;

procedure TFormBlender.FormShow(Sender: TObject);
begin
  Temporizador.Enabled := True;
end;

class function TFormBlender.ShowMe(AOwner: TForm; AInternalForm: TFormClass): TModalResult;
begin
  with Self.Create(AOwner) do
    try
      FInternalForm := AInternalForm;
      Result := ShowModal;
    finally
      Close;
      Free;
    end;
end;

procedure TFormBlender.TemporizadorTimer(Sender: TObject);
begin
  Temporizador.Enabled := False;
  with FInternalForm.Create(Self) do
    try
      // Configura o form interno para que ele não tenha bordas
      BorderStyle := bsNone;

      // Centraliza o form interno
      Top := Self.Top + Self.Height div 2 - Height div 2;
      Left := Self.Left + Self.Width div 2 - Width div 2;

      // Ao atribuir Self.ModalResult, TFormBlender vai fechar e retornar esse
      // modal result na função TFormBlender.ShowMe
      Self.ModalResult := ShowModal;
    finally
      Close;
      Free;
    end;
end;

end.