TActionList в dll

[Dec]

Если в Ваших формах, созданных в dll, не вызываются Action.Update, не появляются hint`ы, не приходит сообщение CM_MOUSELEAVE, то следующий код должен вам помочь. Вызывайте IncDllIdleRef в конструкторе и DecDllIdleRef в деструкторе формы.

Код: Выделить всё

//******************************************************************************
// (c) 2007 Dec AnisimovDec at mail dot ru
// version 1.02
//******************************************************************************

unit decDllIdle;

{$DEFINE TRACE}

interface

uses Windows, Messages, SysUtils, Classes, Forms;

procedure IncDllIdleRef;
procedure DecDllIdleRef;

implementation

uses AppEvnts;

type
  TAppHack = class(TApplication);
  TCustomFormHack = class(TCustomForm);

  TApplicationEventsEx = class(TApplicationEvents)
  public
    constructor Create; reintroduce;
  private
    procedure OnIdleEvent(Sender: TObject; var Done: Boolean);
  end;

constructor TApplicationEventsEx.Create;
begin
  inherited Create(nil);
  OnIdle := OnIdleEvent;
end;

procedure TApplicationEventsEx.OnIdleEvent(Sender: TObject; var Done: Boolean);
var i: Integer;
begin
  for i := 0 to Screen.CustomFormCount - 1 do
    with TCustomFormHack(Screen.CustomForms[i]) do
      if HandleAllocated and IsWindowVisible(Handle) and
        IsWindowEnabled(Handle) then
          UpdateActions;
  Done := false;
end;

var _MessageHook: HHOOK;
    _MessageHookRef: integer;
    _IdleClient: TApplicationEvents;

function MessageProc(ACode: integer; AWParam: WPARAM; AMsg: PMsg): LRESULT; stdcall;
var Msg: TMsg;
begin
  Result := CallNextHookEx(_MessageHook, ACode, AWParam, LParam(AMsg));
  if (ACode = HC_ACTION) and (AWParam = PM_REMOVE) then
    if not PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) or
      ((AMsg.message = WM_PAINT) and (AMsg.hwnd = Msg.hwnd))then
      try
        TAppHack(Application).Idle(Msg);
      except
      end;
end;

procedure IncDllIdleRef;
begin
  if _MessageHookRef = 0 then
    begin
      _MessageHook := SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, 0, GetCurrentThreadId);
      _IdleClient := TApplicationEventsEx.Create;
    end;
  Inc(_MessageHookRef);
end;

{$IFDEF TRACE}
procedure Error;
begin
  MessageBox(0, PChar(Format('Invalid DllIdleRef value (%d)!!!', [_MessageHookRef])), PChar(GetModuleName(HInstance)), MB_ICONERROR);
end;
{$ENDIF}

procedure DecDllIdleRef;
begin
  Dec(_MessageHookRef);
  if _MessageHookRef = 0 then
    begin
      _IdleClient.Free;
      UnhookWindowsHookEx(_MessageHook);
    end;
  {$IFDEF TRACE}
  if _MessageHookRef < 0 then
    Error;
  {$ENDIF}
end;

initialization
  _MessageHookRef := 0;

finalization
  {$IFDEF TRACE}
  if _MessageHookRef > 0 then
    Error;
  {$ENDIF}
  while _MessageHookRef > 0 do
    DecDllIdleRef;

end.