Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Контекстное меню файлового браузера, Контекстное меню проводника Windows 
:(
    Опции темы
Keeper89
Дата 4.11.2009, 01:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
Возобновляю тему smile

Сделал копирование контекстного меню в TBPopupMenu:
Код

...
  private
    { Private declarations }

    g_pcm1: IContextMenu;
    g_pcm2: IContextMenu2;
    g_pcm3: IContextMenu3;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
  end;
...
procedure TForm1.WndProc(var Message: TMessage);
begin
  if Assigned(g_pcm3) then
  begin
    if SUCCEEDED(g_pcm3.HandleMenuMsg2(Message.Msg, Message.wParam, Message.lParam, Message.Result)) then
      Exit;
  end
  else
  if Assigned(g_pcm2) then
    if SUCCEEDED(g_pcm2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam)) then
    begin
      Message.Result := 0;
      Exit;
    end;
  inherited;
end;

procedure FillMyMenu(MyHMenu: HMenu; rootMenu: TTBCustomItem = nil);
var
  NewSep: TTBSeparatorItem;
  curMenuItem, newMenu: TTBCustomItem;
  i: Integer;
  curText: string;
  Info: TMenuItemInfo;
  curBitmap: TBitmap;
  hasSubFolders: Boolean;
begin

  // Выбираем корень для добавления меню
  if Assigned(rootMenu) then
    curMenuItem := rootMenu
  else
  begin
    curMenuItem := Form1.TBPopupMenu1.Items;
    Form1.ImageList1.Clear;
  end;


  if MyHMenu <> 0 then
  begin

    curMenuItem.Clear; 

    with curMenuItem do
    begin
      for i := 0 to GetMenuItemCount(MyHMenu) - 1 do
      begin
        FillChar(Info, SizeOf(TMenuItemInfo), 0);
        with Info do
        begin
          fMask := MIIM_FTYPE or MIIM_STRING or MIIM_SUBMENU or
                   MIIM_BITMAP or MIIM_STATE;
          fType := MFT_STRING;
          cbSize := SizeOf(TMenuItemInfo);
        end;
        if GetMenuItemInfo(MyHMenu, i, True, Info) then
        begin
          if Info.fType = MFT_SEPARATOR then
          begin
            NewSep := TTBSeparatorItem.Create(curMenuItem);
            Add(NewSep);
          end
          else
          begin
            // Есть вложенния или нет
            hasSubFolders := Info.hSubMenu <> 0;

            if hasSubFolders then
              newMenu := TTBSubmenuItem.Create(curMenuItem)
            else
              newMenu := TTBItem.Create(curMenuItem);
            // Текст
            SetLength(curText, Info.cch);
            Info.dwTypeData := @curText[1];
            newMenu.Caption := curText;
            // Стиль
            case Info.fState of
              MFS_DEFAULT:
                newMenu.Options := [tboDefault];
              MFS_DISABLED:
                newMenu.Enabled := False;
            end;
//            // Картинка
//            if Info.hbmpItem <> 0 then
//            begin
//              curBitmap := TBitmap.Create;
//              curBitmap.Handle := Info.hbmpItem;
//              Form1.ImageList1.Add(curBitmap, nil);
//            end;
            Add(newMenu);
            // Заполняем дочернее меню если оно есть
            if hasSubFolders then
              FillMyMenu(Info.hSubMenu, newMenu);

            Inc(Info.cch);
            GetMenuItemInfo(MyHMenu, i, True, Info);
          end;
        end;
      end;
    end;
  end;
end;

procedure DoIT(const MyHMenu: HMENU; X, Y: Integer);
var
  k: Integer;
begin
  with Form1 do
  begin
    FillMyMenu(MyHMenu);
    // Здесь будет добавляться мое меню
    TBPopupMenu1.Popup(X, Y);
  end;
end;

procedure TForm1.ShellListView1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
const
  SCRATCH_QCM_FIRST = 1;
  SCRATCH_QCM_LAST  = $7FFF;
var
  MyHMenu: HMENU;
  Info: TCMInvokeCommandInfoEx;
  Pt: TPoint;
  iCmd: Integer;
  AFolder: TShellFolder;
  PIDL: PItemIDList;
begin
  Handled := True;

  Pt := ShellListView1.ClientToScreen(MousePos);
  if (Pt.X = -1) and (Pt.Y = -1) then
  begin
    Pt.X := 0;
    Pt.Y := 0;
  end;

  // Определеяем выбранную папку  
  if Assigned(ShellListView1.Selected) then
    AFolder := ShellListView1.SelectedFolder
  else
    AFolder := ShellTreeView1.SelectedFolder;
  PIDL := AFolder.RelativeID;

  // Обработка меню
  if SUCCEEDED(AFolder.ParentShellFolder.
                GetUIObjectOf(Handle, 1, PIDL,
                              IID_IContextMenu, nil, g_pcm1)) then
  try
    MyHMenu := CreatePopupMenu;
    if MyHMenu <> 0 then
    try
      if SUCCEEDED(g_pcm1.QueryContextMenu(MyHMenu, 0, SCRATCH_QCM_FIRST, SCRATCH_QCM_LAST, CMF_NORMAL)) then
      begin
        g_pcm1.QueryInterface(IID_IContextMenu2, g_pcm2);
        g_pcm1.QueryInterface(IID_IContextMenu3, g_pcm3);
        try
//          iCmd := Integer(TrackPopupMenuEx(MyHMenu, TPM_RETURNCMD,
//                          Pt.X, Pt.y, Form1.Handle, nil));
        finally
          g_pcm2 := nil;
          g_pcm3 := nil;
        end;

        DoIT(MyHMenu, Pt.X, Pt.Y);

        if iCmd > 0 then
        begin
          FillChar(Info, SizeOf(Info), 0);
          Info.cbSize := SizeOf(info);
          Info.hwnd := Handle;
          Info.fMask := CMIC_MASK_UNICODE;
          Info.lpVerb  := MAKEINTRESOURCEA(iCmd - SCRATCH_QCM_FIRST);
          Info.lpVerbW := MAKEINTRESOURCEW(iCmd - SCRATCH_QCM_FIRST);
          Info.nShow := SW_SHOWNORMAL;
          SetLastError(g_pcm1.InvokeCommand(PCMInvokeCommandInfo(@Info)^));
//          if GetLastError <> 0 then
//            RaiseLastOSError;
        end;
 
      end;
    finally
      DestroyMenu(MyHMenu);
    end;
  finally
    g_pcm1 := nil;
  end;
end;

В принципе выглядит вполне кошерно (слева стандартное, справа мое):
user posted image

Не получаются некоторые вещи:
0) Получать "эксплорерное" меню при щелчке по пустому месту в ShellListView;
1) Добавлять иконки контекстного меню к себе (закомментированные строчки);
2) Отобрать вложенные меню (IContextMenu2 и IContextMenu3) "Отправить" или "Открыть с помощью", хотя в системном меню как положено обрабатываются в WndProc;
3) Выполнять команды в своем меню (эмулировать нажатие системного КМ).

Что из этого реально (возможно) сделать и как подступиться? smile

Это сообщение отредактировал(а) Keeper89 - 4.11.2009, 02:10


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
bems
Дата 4.11.2009, 22:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88
прочтитай цикл, начинающийся вон там


--------------------
Обижено школьников: 8
PM MAIL   Вверх
Keeper89
Дата 5.11.2009, 00:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
bems, давно прочтен smile


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Rrader
  Дата 5.11.2009, 18:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 29
Всего: 191
Keeper89, выложи тестовый пример с TB, облегчи жизнь желающим помочь smile 


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
CodeMonkey
Дата 5.11.2009, 18:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
WndProc вообще вызывается? И с нужными сообщениями? И интерфейсы не nil?

Не понял, зачем там CreatePopupMenu с FillMyMenu. Как-то мешанина: два меню и оба попапаются. Чё-то куда-то зачем-то копируется... 


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Keeper89
Дата 5.11.2009, 18:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
Rrader, прикрепил проект вместе с EXE.
ToolBar2000 здесь.

Цитата(CodeMonkey @  5.11.2009,  19:33 Найти цитируемый пост)
WndProc вообще вызывается? И с нужными сообщениями?

На счет этого сомневаюсь  smile , т.к., afaik, данные вложенные контекстные меню инициализируются только при попытке их открытии. 
Цитата(CodeMonkey @  5.11.2009,  19:33 Найти цитируемый пост)
Не понял, зачем там CreatePopupMenu с FillMyMenu. Как-то мешанина: два меню и оба попапаются. Чё-то куда-то зачем-то копируется...  

Я только инициализирую системное меню и беру из него данные, поэтому TrackPopupMenuEx закомментирована.

Это сообщение отредактировал(а) Keeper89 - 5.11.2009, 19:01

Присоединённый файл ( Кол-во скачиваний: 19 )
Присоединённый файл  ContextMenus.7z 270,42 Kb


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Keeper89
Дата 10.11.2009, 13:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
Есть идеи?  smile 


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
CodeMonkey
Дата 11.11.2009, 19:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
...мне лениво...


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0748 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.