Перехват сообщений в классе

[grominfo]

Всем привет!

Вопрос такой. Есть компонент, наследник TWebBrowser. Добавлены методы работы с формами, и другими объектами DOM. Хочу сделать также свое контекстное меню, но не знаю, как назначить обработчик сообщений для всех экземпляров класса. Пока делаю так:

var
Popup:TPopupMenu;

constructor TAGBrowser.Create(AOwner: TComponent);
begin
  inherited;
  popup:=self.PopupMenu;
  HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
end;

function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var szClassName: array[0..255] of Char;
    p:Tpoint;
const
  ie_name = 'Internet Explorer_Server';
begin
  case nCode < 0 of
    True:
      Result := CallNextHookEx(HookID, nCode, wParam, lParam)
      else
        case wParam of  
          WM_RBUTTONDOWN,
          WM_RBUTTONUP:
            begin
              GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName));
              if lstrcmp(@szClassName[0], @ie_name[1]) = 0 then
              begin
                Result := HC_SKIP; // Прячу попап IE
                GetCursorPos(p);
                if  Popup <> nil then
                  begin
                    Popup.Popup(p.x,p.y);//показываю свое попап
                  end;
              end
              else
                Result := CallNextHookEx(HookID, nCode, wParam, lParam);  
            end
            else
              Result := CallNextHookEx(HookID, nCode, wParam, lParam);
        end;
  end;
end;

Но данный способ работает только для одного компонента, самого последнего. А у меня в программе много вкладок, и почти на каждой есть этот компонент.

Можно ли как-то внедрить каллбэк функцию в сам класс? Или можно ли в каллбэк функции обработать сообщения сразу для всех экземпляров класса?

[grominfo]

Всем спасибо за ответы!

Поразмыслив немного, решил, что локальный хук тут неуместен, и пошел другим путем. А именно, путем отлова сообщений TApplication

constructor TAGBrowser.Create(AOwner: TComponent);
begin
  inherited;
  forms.Application.OnMessage:=AppMessage;
end;

procedure TAGBrowser.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
 p: TPoint;
begin
GetCursorPos(p);
case msg.message of
  WM_RBUTTONDOWN, WM_RBUTTONUP: self.PopupMenu.Popup(p.x,p.y);// Показываем свое PopupMenu вместо стандартного IE
  end;
end;

[Stilet]

Я лично так никогда не делал.

[Пепел Феникса]

если уж на то пошло то внутри своего приложения можно в принципе оконную процедуру для окна подменить, без хуков.(тока старую сохранить надо)
см SetWindowLong.

[grominfo]

Вот полная процедура перехвата нажатий кнопок в браузере. Тут проверяется, выполнен ли правый клик именно на компоненте, а также реализована поддержка функциональных клавиш и исключение акцесс виолейшен

constructor TAGBrowser.Create(AOwner: TComponent);
begin
  inherited;
   FA:=True;
  forms.Application.OnMessage:=AppMessage;
end;

destructor TAGBrowser.Destroy;
begin
  FA:=false;
  inherited;
end;

procedure TAGBrowser.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
 p: TPoint;
 iOIPAO: IOleInPlaceActiveObject;
 Dispatch: IDispatch;
begin
if not FA then exit;
      if not Assigned(Self) then
        begin
          Handled:= False;
          Exit;
        end;
      Handled:= IsDialogMessage(Self.Handle, Msg);
      if (Handled)  then
        begin
          GetCursorPos(p);
          if not Assigned(FOleInPlaceActiveObject) then
            begin
              Dispatch := Self.Application;
              if Assigned(Dispatch) then
                begin
                  Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
                  if Assigned(iOIPAO) then FOleInPlaceActiveObject:= iOIPAO;
                end;
            end;
          if Assigned(FOleInPlaceActiveObject) then
            begin
              FOleInPlaceActiveObject.TranslateAccelerator(Msg);
              if Msg.wParam = VK_RETURN then
                begin

                end;
            end;
          case msg.message of
            WM_RBUTTONDOWN, WM_RBUTTONUP:
              begin
                if self.PopupMenu <> nil then
                  self.PopupMenu.Popup(p.x,p.y); //свое PopupMenu
              end;
          end;

        end;
end;

если уж на то пошло то внутри своего приложения можно в принципе оконную процедуру для окна подменить, без хуков.(тока старую сохранить надо)
см SetWindowLong.

Ну почти тоже самое и получилось, только с перехватом сообщений

[Пепел Феникса]

а теперь создайте два браузера и уничтожьте один из них

как вариант хранить количество существующих компонентов.
(тока не забываем менять счетчик через Interlocked функции, на всякий случай)

[grominfo]

а теперь создайте два браузера и уничтожьте один из них

Обидно, однако! Только проблема не после уничтожения, а после создания. Как и в случае с хуком, обрабатывается только последний компонент.

Как быть?

[grominfo]

Проблему решил следующим образом

var
FAGBObjectList:TStrings;
implementation


{ TAGBrowser }

procedure Register;
begin                                                                                                                          
  RegisterComponents('Andrey Grom Components', [TAGBrowser]);
end;

constructor TAGBrowser.Create(AOwner: TComponent);
begin
  inherited;
   if FAGBObjectList=nil then
    FAGBObjectList:=TStringlist.Create;
    FIndex:= FAGBObjectList.Count;
    FAGBObjectList.AddObject(IntToStr(FIndex), self);
  forms.Application.OnMessage:=AppMessage;
end;

destructor TAGBrowser.Destroy;
var
i:integer;
begin
  i:= FAGBObjectList.IndexOf(IntToStr(FIndex));
  if i>-1 then FAGBObjectList.Delete(i);
  if FAGBObjectList.Count=0 then FAGBObjectList.Free;
  FA:=false;
  inherited;
end;

procedure TAGBrowser.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
 p: TPoint;
 iOIPAO: IOleInPlaceActiveObject;
 Dispatch: IDispatch;
 i:integer;
begin
if FAGBObjectList.Count = 0 then exit;
for i:=0 to FAGBObjectList.Count-1 do
 begin
      if not Assigned(FAGBObjectList.Objects[i]) then
        begin
          Handled:= False;
          Exit;
        end;
      Handled:= IsDialogMessage(TAGBrowser(FAGBObjectList.Objects[i]).Handle, Msg);
      if (Handled)  then
        begin
          GetCursorPos(p);
          if not Assigned(FOleInPlaceActiveObject) then
            begin
              Dispatch := TAGBrowser(FAGBObjectList.Objects[i]).Application;
              if Assigned(Dispatch) then
                begin
                  Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
                  if Assigned(iOIPAO) then FOleInPlaceActiveObject:= iOIPAO;
                end;
            end;
          if Assigned(FOleInPlaceActiveObject) then
            begin
              FOleInPlaceActiveObject.TranslateAccelerator(Msg);
              if Msg.wParam = VK_RETURN then
                begin
                    // Это мне потом понадобится, обработка клавиши Энтер
                end;
            end;
          case msg.message of
            WM_RBUTTONDOWN, WM_RBUTTONUP:
              begin
                if TAGBrowser(FAGBObjectList.Objects[i]).PopupMenu <> nil then
                  TAGBrowser(FAGBObjectList.Objects[i]).PopupMenu.Popup(p.x,p.y);  //свое PopupMenu
              end;
          end;

        end;
 end;
end;