Añadiendo propiedades a un formulario

Vuelvo a estar en deuda con Ray Lischner (www.tempest-sw.com) pues este truco simplemente desarrolla la técnica que describe en su propia página. De lo que se trata es de definir nuevas clases de formularios (TForm) que incorporen nuevas propiedades y eventos, de modo tal que éstas puedan ser editadas en el propio Inspector de Objetos.

Definir un nuevo componente basado en TForm.
Crear un experto.

DEFINIR UN NUEVO COMPONENTE BASADO EN TFORM

El primer paso consiste en definir el nuevo formulario que queremos utilizar, basándonos en el tipo TForm. No es estrictamente necesario que se el ancestro sea precisamente TForm; naturalmente, puede ser también un derivado de TDataModule, pero lo interesante es que podemos utilizar con el mismo éxito cualquier derivado de TWinControl. En este ejemplo, por simplificar, solamente utilizaré formularios.

El nuevo tipo de formulario debe crearse dentro de un package de tiempo de ejecución. Podemos utilizar un package mixto, para diseño y ejecución, pero es preferible mover el código de tiempo de diseño fuera, para evitar sobrecargar de código a los programas que utilicen el formulario.

He aquí una sencilla clase que define una propiedad, un par de métodos de clase, y que intercepta eventos de modo transparente para el programador:

type
  TDatabaseForm = class(TForm)
  private
    FOldCloseQuery: TCloseQueryEvent;
    FOldClose: TCloseEvent;
    FDataSet: TDataSet;
    procedure SetDataSet(Value: TDataSet);
  protected
    procedure InternalClose(Sender: TObject; var Action: TCloseAction);
    procedure InternalCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Loaded; override;
    procedure Notification(C: TComponent; Op: TOperation); override;
  public
    class procedure Mostrar;
    class function Ejecutar: TModalResult;
  published
    property DataSet: TDataSet read FDataSet write SetDataSet;
  end;

Los procedimientos de clase se implementan del siguiente modo:

class function TDatabaseForm.Ejecutar: TModalResult;
begin
  Result := Create(nil).ShowModal;
end;

class procedure TDatabaseForm.Mostrar;
var
  I: Integer;
  F: TForm;
begin
  LockWindowUpdate(Application.MainForm.Handle);
  try
    for I := Screen.FormCount - 1 downto 0 do
    begin
      F := Screen.Forms[I];
      if F.ClassType = Self then
      begin
        if F.WindowState = wsMinimized then
          F.WindowState := wsNormal;
        F.BringToFront;
        Exit;
      end;
      Create(Application).Show;
    end;
  finally
    LockWindowUpdate(0);
  end;
end;

El funcionamiento de estos métodos está explicada en La Cara Oculta de Delphi 4 (un poco de autobombo, ¿puedo?). Ahora los métodos relacionados con el mantenimiento del puntero al conjunto de datos:

procedure TDatabaseForm.SetDataSet(Value: TDataSet);
begin
  if Value <> FDataSet then
  begin
    FDataSet := Value;
    if Value <> nil then Value.FreeNotification(Self);
  end;
end;

procedure TDatabaseForm.Notification(C: TComponent; Op: TOperation);
begin
  inherited Notification(C, Op);
  if (C = FDataSet) and (Op = opRemove) then
    FDataSet := nil;
end;

Durante la ejecución del nuevo Loaded se enganchan nuestros propios manejadores de eventos:

procedure TDatabaseForm.Loaded;
begin
  inherited Loaded;
  FOldClose := OnClose;
  FOldCloseQuery := OnCloseQuery;
  OnClose := InternalClose;
  OnCloseQuery := InternalCloseQuery;
end;

La respuesta interna a OnClose es muy sencilla:

procedure TDatabaseForm.InternalClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if Assigned(FOldClose) then FOldClose(Sender, Action);
  Action := caFree;
end;

La respuesta a OnCloseQuery es un poco más larga:

procedure TDatabaseForm.InternalCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Assigned(FOldCloseQuery) then
  begin
    FOldCloseQuery(Sender, CanClose);
    if not CanClose then Exit;
  end;
  if Assigned(FDataSet) and FDataSet.Active then 
    if ModalResult in [mrOk, mrNone] then
      FDataSet.CheckBrowseMode
    else
      FDataSet.Cancel;
end;

Con esto terminamos la programación del package de tiempo de ejecución.

CREAR UN EXPERTO

Para poder aprovechar un formulario con nuevas propiedades y eventos, necesitamos un experto que cree formularios del nuevo tipo. El experto puede crearse en otro package, esta vez de tiempo de diseño, en el cual debemos además registrar el nuevo tipo de formulario a la medida. En la unidad DsgnIntf se define el siguiente método:

procedure RegisterCustomModule(BaseClass: TComponentClass;
  CustomModule: TCustomModuleClass);

El tipo TCustomModuleClass es una referencia a clases derivadas de TCustomModule, también definida en DsgnIntf. Para registrar un formulario personalizado debemos llamar a este procedimiento dentro de un procedimiento denominado Register:

procedure Register;
begin
  RegisterCustomModule(TDatabaseForm, TCustomModule);
  // Aquí podemos también registrar componentes y expertos
end;

Pero podemos también definir una clase derivada de TCustomModule, si deseamos, por ejemplo, añadir comandos al menú de contexto del formulario:

type
  TDatabaseCustomModule = class(TCustomModule)
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): string; override;
    procedure ExecuteVerb(Index: Integer); override;
  end;

GetVerbCount indica el número de comandos a añadir, GetVerb debe indicar el texto del comando, y ExecuteVerb debe redefinirse para ejecutar dichos comandos:

function TDatabaseCustomModule.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TDatabaseCustomModule.GetVerb(Index: Integer): string;
begin
  Result := '';
  if Index = 0 then
    Result := 'Alinear componentes...';
end;

procedure TDatabaseCustomModule.ExecuteVerb(Index: Integer);
begin
  AlinearComponentes(Root);
  // Esta se la debo, J
end;