Form padre, hijos y alphablendvalue

[[escafandra]]

Voy a poner un ejemplo de como implementar cualquier función de tratamiento de mensajes en una ventana aún no siendo diseñada en tiempo de diseño. La técnica es hacer un Subclassing.

Vamos a cambiar la función de tratamiento de mensajes de la ventana a bajo nivel y vamos a guardar el puntero a la antigua función para poder llamarla a la salida de nuestra nueva función (como si fuera una especie de inherited) Con esto conseguimos cambiar el comportamiento de la ventana para los aspectos que nos interesen y respetar el resto.

Para guardar el puntero a la antigua función de tratamiento de mensajes utilizaré el Tag del TWinControl.

Este sería el código resultante para el tema de este hilo usando subclassing:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}
// Nueva función de Tratamiento de mensajes
// solo nos interesa tratar WM_MOVING
function ChildWindowProc(hWnd: HWND; uMsg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  ChWidth, ChHeight: integer;
  MainRect, ChRect: TRect;
  WinControl: TWinControl;
begin
  if uMsg = WM_MOVING then
  begin
    Windows.GetClientRect(Application.MainForm.Handle, MainRect);
    MapWindowPoints(Application.MainForm.Handle, 0, MainRect, 2);
    Windows.GetWindowRect(hWnd, ChRect);
    ChWidth:=  ChRect.Right - ChRect.Left;
    ChHeight:= ChRect.Bottom - ChRect.Top;
    if PRECT(lParam).Left < MainRect.Left then
    begin
      PRECT(lParam).Left:= MainRect.Left;
      PRECT(lParam).Right:= MainRect.Left + ChWidth;
    end;
    if PRECT(lParam).Top < MainRect.Top then
    begin
      PRECT(lParam).Top:= MainRect.Top;
      PRECT(lParam).Bottom:= MainRect.Top + ChHeight;
    end;
    if PRECT(lParam).Left > MainRect.Right - ChWidth then
    begin
      PRECT(lParam).Left:= MainRect.Right - ChWidth;
      PRECT(lParam).Right:= MainRect.Right;
    end;
    if PRECT(lParam).Bottom > MainRect.Bottom then
    begin
      PRECT(lParam).Top:= MainRect.Bottom - ChHeight;
      PRECT(lParam).Bottom:= MainRect.Bottom;
    end;
  end;

  // Llamamos a la función original de tratamiento de mensajes de la ventana
  Result:= 0;
  WinControl:= FindControl(hWnd);
  if (WinControl <> nil) and (WinControl.Tag <> 0) then
    Result:= CallWindowProc(Pointer(FindControl(hWnd).Tag), hWnd, uMsg, WParam, lParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TForm.Create(self) do
  begin
    Left:= self.Left + (self.Width - Width) div 2;
    Top:=  self.Top  + (self.Height - Height) div 2;
    AlphaBlend:= true;
    AlphaBlendValue:= 80;
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
    // Aquí se realiza el subclassing y se guarda la antigua función
    Tag:= SetWindowLong(Handle, GWL_WNDPROC, LongInt(@ChildWindowProc));
  end;
end;

procedure TForm1.WMMoving(var Message: TWMMOVING);
var
  i: integer;
begin
  inherited;
  for i:= 0 to ComponentCount-1 do
  begin
    if Components[i].ClassName <> 'TForm' then continue;
    with Components[i] as TForm do
      SetWindowPos(Handle, 0, Message.DragRect.Left + Left - self.Left,
                                         Message.DragRect.Top + Top - self.Top,
                                         0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOZORDER);
  end;
end;

end.

Saludos.