VPF::Отцы и дети - Форум программистов

rOOxus

Дата 19.4.2009, 21:52 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Awaiting Authorisation
Сообщений: 95
Регистрация: 28.8.2006

Репутация: нет
Всего: нет

вы знаете - сгодилось! сверстал на основе исходников того модуля, ссылку на который вы дали. так что если кто еще интересуеться, то вот:

Создаем функцию, котораая определит являеться ли окно окном MDIChild
Пишем функцию hook-а, которая отловит все действия с окнами в данном приложении (т.е. имеем локальную ловушку)
В событии OnCreate главной формы устанавливаем hook
В событии OnDestroy главной формы снимаем hook
Ну и при создании кнопки вешаем ей на OnClick событие, которое по ее Tag отышет MDI е таким же Handle и покажет его

небольшая тонкость - hook отлавливает события до их наступления, поэтому невозможно определить станет ли создаваемое окно MDIChild до его создания. поэтому создание кнопки окна на ToolBar делаеться при наступлении события установки форкуса на окно т.е. вместо HCBT_CREATEWND ловушка реагирует на HCBT_SETFOCUS и если кнопка окна уже есть, то топит ее, а если нет, то создает и топит.

Код


...

var
  CBTHookHandle: HHOOK;

// функци определения являеться ли окно MDIChild и определения его заголовка
function WindowIsMDIChild(W: HWND; var WinCaption : String ): Boolean;
var
  i: Integer;
  MainForm, ChildForm: TForm;
begin
  MainForm := Application.MainForm;
  if Assigned(MainForm) then
    for i := 0 to MainForm.MDIChildCount-1 do begin
      ChildForm := MainForm.MDIChildren[i];
      if ChildForm.HandleAllocated and (ChildForm.Handle = W) then
      begin
        WinCaption := ChildForm.Caption;
        Result := true;
        Exit;
      end;
    end;
  Result := False;
end;

// собственно Hook
function CBTHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
stdcall;
var
   i, Index : Integer;
   WndExists : Boolean;
   Item : TTBItem;
   WinCaption : string;
begin
   case Code of
      // активация окна
      HCBT_SETFOCUS :
      begin
         // если окно MDICild
         if WindowIsMDIChild ( HWND(WParam), WinCaption ) then
         begin
            // определяем есть ли на ToolBar кнопка с Tag равным
            // Handle окна
            WndExists := False;
            for i := 0 to MainForm.tb_WindowTB.Items.Count - 1 do
            begin
               if MainForm.tb_WindowTB.Items.Items[i].Tag = HWND(WParam) then
               begin
                  WndExists := True;
                  Index := i;
               end;
            end;

            // если нет, то создаем ее
            if not WndExists then
            begin
               Item := TTBItem.Create( nil );
               Item.Caption := WinCaption;
               Item.GroupIndex := 1;
               Item.AutoCheck := true;
               Item.Tag := HWND(WParam);
               Item.OnClick := MainForm.OnWinBtnClick;
               MainForm.tb_WindowTB.Items.Add( Item );
               Item.Checked := True;
            end
            // если есть, то топим
            else
            begin
               MainForm.tb_WindowTB.Items.Items[Index].Checked := True;
            end;
         end;
      end;
      // окно уничтожено
      HCBT_DESTROYWND :
      begin
         // если окно MDICild
         if WindowIsMDIChild ( HWND(WParam), WinCaption ) then
         begin
            // ищем на ToolBar кнопку с Tag равным Handle окна...
            for i := 0 to MainForm.tb_WindowTB.Items.Count - 1 do
            begin
               if MainForm.tb_WindowTB.Items.Items[i].Tag = HWND(WParam) then
               begin
                  Index := i;
               end;
            end;
            // ... и уничтожаем ее
            MainForm.tb_WindowTB.Items.Delete( Index );
         end;
      end;
   end;
   Result := CallNextHookEx(CBTHookHandle, Code, WParam, LParam);
end;

...

procedure TMainForm.FormCreate(Sender: TObject);
begin
   // Устанавливаем Hook
   if CBTHookHandle = 0 then
      CBTHookHandle := SetWindowsHookEx( WH_CBT, CBTHook, 0, GetCurrentThreadId );
end;

...

// Событие нажатия кнопки
procedure TMainForm.OnWinBtnClick(Sender: TObject);
var
   i : Integer;
begin
   TTBItem (Sender).Checked := true;
   for i := 0 to MainForm.MDIChildCount - 1 do
   begin
      if TTBItem (Sender).Tag = MainForm.MDIChildren[i].Handle then
         MainForm.MDIChildren[i].Show;
   end;
end;

...

procedure TMainForm.FormDestroy(Sender: TObject);
begin
   // Снимаем Hook
   UnhookWindowsHookEx(CBTHookHandle);
end;

Это сообщение отредактировал(а) rOOxus - 19.4.2009, 21:55

Bose

Дата 20.4.2009, 03:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Цитата(rOOxus @ 19.4.2009, 20:52

)

вы знаете - сгодилось! сверстал на основе исходников того модуля, ссылку на который вы дали.

Вы знаете, я забыл упомянуть. Те исходники распространяются по какой-то хитрой лицензии. Для коммерческого использования там что-то особенное требовалось. Хотя, до автора, за последние пару лет никому не удалось достучаться. Но всё-таки лучше использовать этот код только как справочное пособие, и писать свой самому.

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

rOOxus

Дата 20.4.2009, 13:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Awaiting Authorisation
Сообщений: 95
Регистрация: 28.8.2006

Репутация: нет
Всего: нет

спасибо. учту smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »