Bitmaps, ventanas MDI y subclassing

¿Cómo podemos dibujar un mapa de bits como fondo de una ventana madre MDI (FormStyle = fsMDIForm)? No es tan fácil como puede parecer a simple vista. La dificultad consiste en que una ventana madre MDI tiene "dos capas": el marco de la ventana, que es la zona donde está la barra de título, los iconos, las barras de herramientas, el menú... y la ventana cliente. Esta ventana corresponde a la zona rectangular interior donde se sitúan las ventanas hijas, y es allí donde queremos dibujar.

La clase TForm de Delphi administra tanto al marco como al cliente. La propiedad Handle de esta clase se refiere al identificador de ventana de la ventana marco creada por Windows. Cuando la propiedad FormStyle vale fsMDIForm, la clase TForm también crea la ventana cliente, y almacena su identificador en la propiedad ClientHandle. Pero, como es poco frecuente que alguien necesite modificar el comportamiento del cliente, los autores de la VCL no preocuparon de transformar los mensajes que el cliente recibe de Windows en eventos disponibles para el desarrollador de Delphi. Así, por ejemplo, cuando se dispara el evento OnPaint de un TForm, nos está indicando que la ventana madre ha recibido desde la cola de la aplicación el mensaje WM_PAINT. Peor aún: supongamos que definimos un manejador de mensajes para el formulario de este modo:

type
  TVentanaPrincipal = class(TForm)
    // ...
  private
    procedure WMPaint(var M: TMessage); message WM_PAINT;
    // ...
  end;

En tal caso, este WM_PAINT se refiere al mensaje que recibe la ventana madre, no la ventana cliente. Conclusión: no existe una forma directa de interceptar los mensajes que llegan a una ventana cliente MDI. Aunque los mensajes del cliente pasan por el procedimiento ClientWndProc de la clase TCustomForm, Borland decidió que este procedimiento perteneciera a la sección private de la clase.

Sin embargo, no todo está perdido, pues echaremos mano de una "sucia" técnica utilizada durante muchos años por los pioneros de la programación con el API de Windows: la creación de subclases, o subclassing. ¿Cómo viene determinado el comportamiento de un objeto de ventana en Windows? Por una rutina denominada procedimiento de ventana, a la cual cada objeto interno de ventana de Windows hace referencia. Este procedimiento de ventana recibe todos los mensajes de la ventana, y en la heroica época en que se programaba para Windows utilizando C, la parte central de un programa consistía en suministrar un procedimiento de ventana adecuado para las ventanas que creaba la aplicación.

La técnica de subclassing consiste en modificar la referencia que contiene un objeto de ventana a su procedimiento de ventana. Se hace que el objeto apunte a un procedimiento nuestro. Dentro de este procedimiento trabajamos con los mensajes que nos interesa, y los que no nos interesan se los devolvemos al procedimiento que estaba instalado antes de que metiéramos nuestras pezuñas en las intimidades del objeto.

Para ilustrar la técnica, voy a desarrollar un componente que en tiempo de ejecución realice este acto de prestidigitación por nosotros. He aquí la declaración del componente:

type
  TimMDIBkg = class(TComponent)
  private
    FBitmap: TBitmap;
    FForm: TForm;
    procedure SetBitmap(Value: TBitmap);
    procedure InternalClientProc(var M: TMessage);
  protected
    FClientInstance: TFarProc;
    FPrevClientProc: TFarProc;
    procedure Loaded; override;
    property Form: TForm read FForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Bitmap: TBitmap read FBitmap write SetBitmap;
  end;

El componente imMDIBkg (¡estoy estrenando el prefijo!) contiene una propiedad de tiempo de diseño llamada Bitmap, que debe almacenar el mapa de bits que dibujaremos en el fondo. Para simplificar, utilizaré una sola modalidad de dibujo, repitiendo el mapa de bits a modo de mosaico. Si usted lo desea, puede ampliar las capacidades del componente, para dibujar solamente en el centro de la ventana, para "estirar" el bitmap y adaptarlo al tamaño del área cliente, para utilizar una "brocha" como fondo, etc.

Además, vemos dos variables FClientInstance y FPrevClientInstance, que apuntarán respectivamente al nuevo y al anterior procedimiento de ventana. Examinemos el constructor:

constructor TimMDIBkg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FForm := AOwner as TForm;
  FBitmap := TBitmap.Create;
end;

El constructor asume que el propietario del componente es un formulario, y se queda con su referencia y ... ¡un momento! ¿No habíamos quedado en redirigir el procedimiento de ventana del cliente? Sí, pero el constructor del componente no se ejecuta en el momento adecuado. Las inicializaciones que requieran que el propietario esté construido y que todas las propiedades del componente hayan sido leídas deben realizarse redefiniendo el método Loaded:

procedure TimMDIBkg.Loaded;
begin
  inherited Loaded;
  FClientInstance := MakeObjectInstance(InternalClientProc);
  FPrevClientProc := Pointer(SetWindowLong(
    Form.ClientHandle, GWL_WNDPROC, Integer(FClientInstance)));
end;

Aquí está el truco. El procedimiento MakeObjectInstance se encarga de generar un thunk. ¡Vaya nombre! Un thunk es un trozo de código que cuando se ejecuta, se limita a llamar a otra rutina Thunk en inglés se pronuncia "zunk", dando la impresión de ser algo rápido. El código del thunk se almacena en un área de memoria pedida dinámicamente, que después hay que liberar. En nuestro caso el thunk redirige al procedimiento InternalClientProc, que veremos en breve. ¿Por qué es necesario? Pues porque InternalClientProc es un método, no un procedimiento tradicional de C o Pascal, que es lo que realmente necesita un objeto para su procedimiento de ventana. Así que la dirección del procedimiento de ventana nuevo estará en FClientInstance, y cuando éste se ejecute, llamará al método InternalClientProc. La cirugía sobre la ventana cliente se realiza llamando a SetWindowLong. Esta función del API de Windows "entra" dentro del formato interno de la ventana y asigno un valor de 4 bytes. La constante GWL_WNDPROC indica la posición donde el objeto almacena la dirección su procedimiento de ventana. Como efecto secundario, SetWindowLong devuelve lo que había antes en esa posición. En este ejemplo, es la dirección del antiguo procedimiento de ventana, la cual almacenaremos en FPrevClientProc.

Los pasos inversos se siguen en el destructor del componente:

destructor TimMDIBkg.Destroy;
begin
  SetWindowLong(Form.ClientHandle,
    GWL_WNDPROC, Integer(FPrevClientProc));
  FreeObjectInstance(FClientInstance);
  FBitmap.Free;
  inherited Destroy;
end;

Es muy sencillo: primero se restaura el anterior procedimiento de memoria. Luego se libera la memoria reservada para el thunk. Finalmente se destruye el mapa de bits y el propio componente.

El algoritmo que dibuja en la superficie de la ventana cliente se implementa en el método InternalClientProc:

procedure TimMDIBkg.InternalClientProc(var M: TMessage);
var
  SrcDC, DstDC: hDC;
  R, C, H, W: Word;
begin
  if not FBitmap.Empty then
    case M.Msg of
      WM_HSCROLL, WM_VSCROLL:
        InvalidateRect(Form.ClientHandle, nil, False);
      WM_ERASEBKGND:
        begin
          SrcDc := Bitmap.Canvas.Handle;
          DstDc := TWMEraseBkGnd(M).DC;
          H := Bitmap.Height;
          W := Bitmap.Width;
          for R := 0 to Form.ClientHeight div H do
            for C := 0 to Form.ClientWidth div W do
              BitBlt(DstDC, C * W, R * H, W, H, SrcDC, 0, 0, SRCCOPY);
          M.Result := 1;
          Exit;
        end;
    end;
  M.Result := CallWindowProc(FPrevClientProc, Form.ClientHandle,
    M.Msg, M.wParam, M.lParam);
end;

Los mensajes tratados son WM_ERASEBKGND, que se dispara cada vez que hay que dibujar el "fondo" de una ventana, y WM_HSCROLL y WM_VSCROLL, que se lanzan cada vez que se toca una barra de desplazamiento. Recuerde que si una ventana hija sale fuera del área cliente, automáticamente aparecen barras de desplazamientos en esa zona. Observe también cómo, al final del método, se tratan los restantes mensajes invocando indirectamente al antiguo procedimiento de ventana mediante CallWindowProc.

Puede descargar el código fuente completo desde aquí, o desde la página de ejemplos.