unit AHMTMHkClass;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
Const AHMCM_RECREATEMENUWINDOW=CM_BASE + 501;
type
  TAHMMenuHookList = class;
  TAHMMenuHookMsg=procedure(var Msg : TMessage;Var Handled : Boolean) of object;
  TAHMMenuHookClass = class(TPersistent)
  private
    FAfterMessage: TAHMMenuHookMsg;
    FOnReloadMenuHook: TNotifyevent;
    FBeforeMessage: TAHMMenuHookMsg;
    FBeforeReload: TNotifyEvent;
  protected
    NewWndProc,OldWndProc : Pointer;
    FIsMDI : Boolean;
    procedure DefineMenuHooks;
  public
    FMenuHookedWnd : TWinControl;
    MenuHookedComponent : TComponent;
    MenuHookedWindowHandle: THandle;
    Constructor Create(HWinComponent,HWinControl : TComponent; IsMDI: Boolean); virtual;
    Destructor Destroy; override;
    procedure MenuHookWin;
    procedure UnMenuHookWin;
    procedure MenuHooked(Var Msg : TMessage);
    procedure UpdateMenuHooks;
    procedure ReloadMenuHook;
    procedure DefaultMessage(Var Msg : TMessage);
  published
    property OnReloadMenuHook : TNotifyevent read FOnReloadMenuHook write FOnReloadMenuHook;
    property BeforeReload : TNotifyEvent read FBeforeReload write FBeforeReload;
    property BeforeMessage : TAHMMenuHookMsg read FBeforeMessage write FBeforeMessage;
    property AfterMessage : TAHMMenuHookMsg read FAfterMessage write FAfterMessage;
  end;
  TAHMMenuHookList = Class(TList)
  private
    procedure WndProc(var Message: TMessage);
  public
    Window: HWND;
    constructor Create;
    destructor Destroy; override;
    function Add(HWinComponent,HWinControl : TComponent; IsMDI: Boolean) : THandle;
    procedure Remove(HWinComponent : TComponent);
  published
  end;

var MenuHookList : TAHMMenuHookList=nil;
implementation

constructor TAHMMenuHookClass.Create(HWinComponent,HWinControl: TComponent; IsMDI: Boolean);
begin
  inherited Create;
  FMenuHookedWnd:=(HWinControl as TWinControl);
  MenuHookedComponent:=HWinComponent;
  FIsMDI:=IsMDI;
  DefineMenuHooks;
  MenuHookWin;
end;

procedure TAHMMenuHookClass.DefineMenuHooks;
begin
  if (FMenuHookedWnd=nil) then
  begin
    MenuHookedWindowHandle:=0;
    exit;
  end;
  if FIsMDI and (FMenuHookedWnd is TForm) then
  begin
{     if (FMenuHookedWnd as TForm).FormStyle=fsMDIForm then
     begin
       if (FMenuHookedWnd as TForm).ClientHandle<>0 then MenuHookedWindowHandle:=(FMenuHookedWnd as TForm).ClientHandle
       else MenuHookedWindowHandle:=FMenuHookedWnd.Handle;
     end else MenuHookedWindowHandle:=FMenuHookedWnd.Handle;}
     MenuHookedWindowHandle:=FMenuHookedWnd.Handle;
  end else MenuHookedWindowHandle:=Application.Handle;
end;

destructor TAHMMenuHookClass.Destroy;
begin
  UnMenuHookWin;
  MenuHookList:=nil;
  FMenuHookedWnd:=nil;
  MenuHookedComponent:=nil;
  inherited Destroy;
end;

procedure TAHMMenuHookClass.DefaultMessage(Var Msg : TMessage);
begin
  with Msg do Result:=CallWindowProc(OldWndProc,MenuHookedWindowhandle, Msg, wParam, lParam);
end;

procedure TAHMMenuHookClass.MenuHooked(var Msg: TMessage);
Var FHandled : Boolean;
begin
  FHandled:=False;
  try
  if ((FMenuHookedWnd=nil) or (MenuHookedComponent=nil)) or
     ((csDestroying in FMenuHookedWnd.Componentstate) or
     (csDestroying in MenuHookedComponent.Componentstate)) or
     (Msg.Msg=CM_RELEASE) then
  begin
    UnMenuHookWin;
    exit;
  end;
//  if (csDestroyingHandle in FMenuHookedWnd.ControlState) then
  if ((Msg.Msg=WM_DESTROY) and not(csDestroying in FMenuHookedWnd.ComponentState)) then
  begin
    UnMenuHookWin;
    with Msg do Result:=CallWindowProc(OldWndProc,MenuHookedWindowhandle, Msg, wParam, lParam);
    if not(csDestroying in Application.Componentstate) then
        PostMessage(MenuHookList.Window, AHMCM_RECREATEMENUWINDOW, 0, Longint(Self));
    exit;
  end;
  if assigned(FBeforeMessage) then FBeforeMessage(Msg,FHandled);
  if not(FHandled) then
  begin
    with Msg do Result:=CallWindowProc(OldWndProc,MenuHookedWindowhandle, Msg, wParam, lParam);
    exit;
    if assigned(FAfterMessage) then FAfterMessage(Msg,FHandled);
  end;
  except
    Application.HandleException(Self);
  end;
end;

procedure TAHMMenuHookClass.MenuHookWin;
begin
  if FMenuHookedWnd=nil then exit;
  if (MenuHookedWindowHandle=0) or (csDestroying in Application.Componentstate) then exit;
  NewWndProc := MakeObjectInstance(MenuHooked);
  OldWndProc := Pointer(SetWindowLong(MenuHookedWindowHandle, GWL_WNDPROC, LongInt(NewWndProc)));
end;

procedure TAHMMenuHookClass.ReloadMenuHook;
begin
  if assigned(FBeforeReload) then FBeforeReload(self);
  DefineMenuHooks;
  MenuHookWin;
  if assigned(FOnReloadMenuHook) then FOnReloadMenuHook(self);
end;

procedure TAHMMenuHookClass.UnMenuHookWin;
begin
  if (NewWndProc=nil) or (MenuHookedWindowHandle=0) or ((Application<>nil) and (csDestroying in Application.Componentstate)) then exit;
  SetWindowLong(MenuHookedWindowHandle, GWL_WNDPROC, LongInt(OldWndProc));
  if NewWndProc<>nil then FreeObjectInstance(NewWndProc);
  NewWndProc := nil;
end;


procedure TAHMMenuHookClass.UpdateMenuHooks;
begin
  UnMenuHookWin;
  DefineMenuHooks;
  MenuHookWin;
end;

{ TAHMMenuHookList }

function TAHMMenuHookList.Add(HWinComponent, HWinControl: TComponent;
  IsMDI: Boolean) : THandle;
Var FAHMMenuHookClass : TAHMMenuHookClass;
begin
  FAHMMenuHookClass:=TAHMMenuHookClass.Create(HWinComponent,HWinControl,IsMDI);
  inherited Add(FAHMMenuHookClass);
  result:=LongInt(FAHMMenuHookClass);
end;

constructor TAHMMenuHookList.Create;
begin
  inherited Create;
  Window := AllocateHWnd(WndProc);
end;

destructor TAHMMenuHookList.Destroy;
begin
  DeallocateHWnd(Window);
  inherited Destroy;
end;

procedure TAHMMenuHookList.Remove(HWinComponent: TComponent);
Var I:Integer;
begin
  I:=Count-1;
  while (I>-1) and (Count>0) do
  begin
     if (TAHMMenuHookClass(Items[I]).MenuHookedComponent=HWinComponent) then
     begin
       TAHMMenuHookClass(Items[I]).UnMenuHookWin;
       inherited Delete(I);
     end;
     Dec(I);
  end;
end;


procedure TAHMMenuHookList.WndProc(var Message: TMessage);
Var I : Integer;
begin
  try
    if (Message.Msg = AHMCM_RECREATEMENUWINDOW) then
     for I:=0 to Count-1 do
      if (TAHMMenuHookClass(Items[I])=TAHMMenuHookClass(Message.LParam)) then
      if TAHMMenuHookClass(Items[I]).FMenuHookedWnd.Handle<>0 then
      TAHMMenuHookClass(Items[I]).ReloadMenuHook
      else PostMessage(Window,AHMCM_RECREATEMENUWINDOW,0,LongInt(TAHMMenuHookClass(Items[I])));
  except
    Application.HandleException(Self);
  end;
end;


initialization
  if MenuHookList=nil then MenuHookList:=TAHMMenuHookList.Create;
finalization
  while MenuHookList.Count>0 do MenuHookList.Delete(MenuHookList.Count-1);
  MenuHookList.Free;

end.
