Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Контекстное меню файлового браузера

Автор: Keeper89 26.2.2009, 16:28

Доброго времени суток!

Делаю файловый браузер на основе ListView и присоединяю свое pop-up меню.
Вопрос в следующем: каким образом можно добавить в свое меню часть контекстного меню проводника Windows с сохранением функциональности?
Желательно небольшой примерчик, а не просто совет "куда копать".

Заранее спасибо.

Автор: Rrader 26.2.2009, 19:43

Можно получать меню итема через IContextMenu, затем обрезать его, как надо. И все это делать только тогда, когда требуется, так наиболее удобно, т.е. не хранить меню smile

Накидал пример - выбираем через OpenDialog файл, для него вызывается меню, у которого оставлены 5 последних итемов (включая separator). Исполнение кода главного потока приостанавливается до тех пор, пока чего-нибудь не нажмём.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, ShlObj, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Malloc: IMalloc;
  ID, ItemID: PItemIDList;
  CM: IContextMenu;
  Desktop: IShellFolder;
  Folder: IShellFolder2;
  PFileName, PPath: PWideChar;
  Menu: HMENU;
  ICI: TCMInvokeCommandInfo;
  ICmd: Integer;
  Command: BOOL;
  I: Integer;
begin
  if OpenDialog1.Execute then
  begin
    { File Name }
    PFileName := StringToOleStr(ExtractFileName(OpenDialog1.FileName));
    { Path }
    PPath := StringToOleStr(ExtractFilePath(OpenDialog1.FileName));
    { Show last 5 items for the Windows directory }
    if Succeeded(SHGetMalloc(Malloc)) then
    try
      { Get Desktop Root IShellFolder2 Interface }
      if Succeeded(SHGetDesktopFolder(Desktop)) then
      try
        { Target Folder }
        if Succeeded(Desktop.ParseDisplayName(0, nil, PPath, PULONG(nil)^,
          ID, PULONG(nil)^)) then
        try
          { Get IShellFolder2 Interface }
          if Succeeded(Desktop.BindToObject(ID, nil,
            IID_IShellFolder2, Folder)) then
          try
            { FileName }
            if Succeeded(Folder.ParseDisplayName(0, nil,
              PFileName, PULONG(nil)^, ItemID, PULONG(nil)^)) then
            try
              if Succeeded(Folder.GetUIObjectOf(0, 1, ItemID, IID_IContextMenu,
                nil, CM)) then
              try
                Menu := CreatePopupMenu;
                if Menu <> 0 then
                try
                  if Succeeded(CM.QueryContextMenu(Menu, 0, 1,
                    $7FFF, CMF_EXPLORE or CMF_CANRENAME)) then
                  begin
                    for I := 0 to GetMenuItemCount(Menu) - 6 do
                      DeleteMenu(Menu, 0, MF_BYPOSITION);
                    { Show }
                    Command := TrackPopupMenu(Menu, TPM_LEFTALIGN
                      or TPM_LEFTBUTTON or TPM_RIGHTBUTTON
                      or TPM_RETURNCMD, Mouse.CursorPos.X, Mouse.CursorPos.Y,
                      0, Handle, nil);
                    if Command then
                    begin
                      ICmd := Integer(Command) - 1;
                      FillChar(ICI, SizeOf(ICI), #0);
                      with ICI do
                      begin
                        cbSize := SizeOf(ICI);
                        hWND := 0;
                        lpVerb := MakeIntResourceA(ICmd);
                        nShow := SW_SHOWNORMAL;
                      end;
                      CM.InvokeCommand(ICI);
                    end;
                  end;
                finally
                  DestroyMenu(Menu);
                end;
              finally
                CM := nil;
              end;
            finally
              Malloc.Free(ItemID);
            end;
          finally
            Folder := nil;
          end;
        finally
          Malloc.Free(ID);
        end;
      finally
        Desktop := nil;
      end;
    finally
      Malloc := nil;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  OleUninitialize;
end;

end.

Автор: Keeper89 26.2.2009, 22:04

Спасибо за пример!

И еще несколько вопросов:
1) как заставить работать код для виртуальных папок (Например Рабочего Стола или Моего Компьютера)?
2) меню Отправить и Открыть с помощью отображаются, но вместо вложенного меню оказывается та же надпись, для WinRAR же например все нормально...
3) можно ли каким то образом добавить полученное меню к своему pop-up?

Автор: Rrader 27.2.2009, 14:57

Цитата(Keeper89 @ 27.2.2009, 04:04

)

1) как заставить работать код для виртуальных папок (Например Рабочего Стола или Моего Компьютера)?

Для получения ItemID виртуальных папок можно воспользоваться функцией http://msdn.microsoft.com/en-us/library/bb762203(VS.85).aspx

Цитата(Keeper89 @ 27.2.2009, 04:04

)

2) меню Отправить и Открыть с помощью отображаются, но вместо вложенного меню оказывается та же надпись, для WinRAR же например все нормально...

Этот случай требует особой обработки. Вот пример:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, ShlObj, ActiveX, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    procedure WndProc(var Msg: TMessage); override;  
  private
    { Private declarations }
  public
    { Public declarations }
    CM2: IContextMenu2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Malloc: IMalloc;
  ID, ItemID: PItemIDList;
  CM: IContextMenu;
  Desktop: IShellFolder;
  Folder: IShellFolder2;
  PFileName, PPath: PWideChar;
  Menu: HMENU;
  ICI: TCMInvokeCommandInfo;
  ICmd: Integer;
  Command: BOOL;
begin
  if OpenDialog1.Execute then
  begin
    { File Name }
    PFileName := StringToOleStr(ExtractFileName(OpenDialog1.FileName));
    { Path }
    PPath := StringToOleStr(ExtractFilePath(OpenDialog1.FileName));
    if Succeeded(SHGetMalloc(Malloc)) then
    try
      { Get Desktop Root IShellFolder2 Interface }
      if Succeeded(SHGetDesktopFolder(Desktop)) then
      try
        { Target Folder }
        if Succeeded(Desktop.ParseDisplayName(0, nil, PPath, PULONG(nil)^,
          ID, PULONG(nil)^)) then
        try
          { Get IShellFolder2 Interface }
          if Succeeded(Desktop.BindToObject(ID, nil,
            IID_IShellFolder2, Folder)) then
          try
            { FileName }
            if Succeeded(Folder.ParseDisplayName(0, nil,
              PFileName, PULONG(nil)^, ItemID, PULONG(nil)^)) then
            try
              if Succeeded(Folder.GetUIObjectOf(0, 1, ItemID, IID_IContextMenu,
                nil, CM)) then
              try
                Menu := CreatePopupMenu;
                if Menu <> 0 then
                try
                  if Succeeded(CM.QueryContextMenu(Menu, 0, 1,
                    UINT(-1), CMF_EXPLORE or CMF_CANRENAME)) then
                  begin
                    Command := False;
                    if Succeeded(CM.QueryInterface(IID_IContextMenu2, CM2)) then
                    try
                      { Show }
                      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN
                        or TPM_LEFTBUTTON or TPM_RIGHTBUTTON
                        or TPM_RETURNCMD, Mouse.CursorPos.X, Mouse.CursorPos.Y,
                        0, Handle, nil);
                    finally
                      CM2 := nil;
                    end;
                    if Command then
                    begin
                      ICmd := Integer(Command) - 1;
                      FillChar(ICI, SizeOf(ICI), #0);
                      with ICI do
                      begin
                        cbSize := SizeOf(ICI);
                        hWND := Handle;
                        lpVerb := MakeIntResourceA(ICmd);
                        nShow := SW_SHOWNORMAL;
                      end;
                      CM.InvokeCommand(ICI);
                    end;
                  end;
                finally
                  DestroyMenu(Menu);
                end; 
              finally
                CM := nil;
              end;
            finally
              Malloc.Free(ItemID);
            end;
          finally
            Folder := nil;
          end;
        finally
          Malloc.Free(ID);
        end;
      finally
        Desktop := nil;
      end;
    finally
      Malloc := nil;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  OleUninitialize;
end;

procedure TForm1.WndProc(var Msg: TMessage);
begin
  { SubMenu Handling }
  with Msg do
    if ((Msg = WM_INITMENUPOPUP) or (Msg = WM_DRAWITEM) or (Msg = WM_MENUCHAR)
    or (Msg = WM_MEASUREITEM)) and Assigned(CM2) then
    begin
      CM2.HandleMenuMsg(Msg, wParam, lParam);
      Result := 0;
    end;
  inherited;
end;

end.

Цитата(Keeper89 @ 27.2.2009, 04:04

)

3) можно ли каким то образом добавить полученное меню к своему pop-up?

Можно добавлять вручную, но придется решать несколько проблем, например, подсчет индекса выбранной команды.

Автор: Keeper89 28.2.2009, 15:18

Цитата(Rrader @ 27.2.2009, 14:57

)

Этот случай требует особой обработки. Вот пример:

Спасибо, работает отлично.

Цитата(Rrader @ 27.2.2009, 14:57

)

Для получения ItemID виртуальных папок можно воспользоваться функцией SHGetSpecialFolderLocation

Пользуюсь следующей функцией для определения ItemID:

Код


function GetSpecialFolderLocation(nFolder: Integer): String;
var
  ppidl: PItemIDList;
  Malloc: IMalloc;
  szPath: array[0..MAX_PATH - 1] of Char;
begin
  SHGetSpecialFolderLocation(0, nFolder, ppidl);
  SHGetMalloc(Malloc);
  SHGetPathFromIDList(ppidl, szPath);
  Malloc.Free(ppidl);
  Malloc := nil;
  Result := String(szPath);
end;

Но при этом меню работает только для папок, к которым можно определить путь (например Рабочий стол), а Мой Компьютер и Рабочий стол как виртуальная папка не работают.

----------

+ еще вопрос: в таком компоненте как ShellListView уже реализовано меню, которое мне необходимо. Можно ли как то его "выдернуть" и добавить из него элементы в своему меню?

Автор: Rrader 1.3.2009, 08:42

Цитата(Keeper89 @ 28.2.2009, 21:18

)

Но при этом меню работает только для папок, к которым можно определить путь (например Рабочий стол), а Мой Компьютер и Рабочий стол как виртуальная папка не работают.

Путь не нужен, нужен ItemID:

Код


SHGetSpecialFolderLocation(0, nFolder, ppidl);

И далее работать нужно с ним через GetUIObjectOf.

Цитата(Keeper89 @ 28.2.2009, 21:18

)

еще вопрос: в таком компоненте как ShellListView уже реализовано меню, которое мне необходимо. Можно ли как то его "выдернуть" и добавить из него элементы в своему меню?

ShellListView использует примерно такой же код, какой привел я. Меню нигде не хранится и не является дельфийским TPopupMenu.

Автор: Keeper89 1.3.2009, 17:32

Цитата(Rrader @ 1.3.2009, 08:42

)

И далее работать нужно с ним через GetUIObjectOf.

Немного подкорректировал ваш код под себя следующим образом, где путь я передаю как параметр:

Код


...
procedure TfrmMain.DoContextMenu(const curPath: String);
var
  Malloc: IMalloc;
  ID, ItemID: PItemIDList;
  CM: IContextMenu;
  Desktop: IShellFolder;
  Folder: IShellFolder2;
  PFileName, PPath: PWideChar;
  Menu: HMENU;
  ICI: TCMInvokeCommandInfo;
  ICmd: Integer;
  Command: BOOL;
begin

  { File Name }
    PFileName := StringToOleStr(ExtractFileName(curPath));
    { Path }
    PPath := StringToOleStr(ExtractFilePath(curPath));
    if Succeeded(SHGetMalloc(Malloc)) then
    try
      { Get Desktop Root IShellFolder2 Interface }
      if Succeeded(SHGetDesktopFolder(Desktop)) then
      try
        { Target Folder }
        if Succeeded(Desktop.ParseDisplayName(0, nil, PPath, PULONG(nil)^,
          ID, PULONG(nil)^)) then
        try
          { Get IShellFolder2 Interface }
          if Succeeded(Desktop.BindToObject(ID, nil,
            IID_IShellFolder2, Folder)) then
          try
            { FileName }
            if Succeeded(Folder.ParseDisplayName(0, nil,
              PFileName, PULONG(nil)^, ItemID, PULONG(nil)^)) then
            try
              if Succeeded(Folder.GetUIObjectOf(0, 1, ItemID, IID_IContextMenu,
                nil, CM)) then
              try
                Menu := CreatePopupMenu;
                if Menu <> 0 then
                try
                  if Succeeded(CM.QueryContextMenu(Menu, 0, 1,
                    UINT(-1), CMF_EXPLORE or CMF_CANRENAME)) then
                  begin
                    Command := False;
                    if Succeeded(CM.QueryInterface(IID_IContextMenu2, CM2)) then
                    try
                      { Show }
                      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN
                        or TPM_LEFTBUTTON or TPM_RIGHTBUTTON
                        or TPM_RETURNCMD, Mouse.CursorPos.X, Mouse.CursorPos.Y,
                        0, Handle, nil);
                    finally
                      CM2 := nil;
                    end;
                    if Command then
                    begin
                      ICmd := Integer(Command) - 1;
                      FillChar(ICI, SizeOf(ICI), #0);
                      with ICI do
                      begin
                        cbSize := SizeOf(ICI);
                        hWND := Handle;
                        lpVerb := MakeIntResourceA(ICmd);
                        nShow := SW_SHOWNORMAL;
                      end;
                      CM.InvokeCommand(ICI);
                    end;
                  end;
                finally
                  DestroyMenu(Menu);
                end; 
              finally
                CM := nil;
              end;
            finally
              Malloc.Free(ItemID);
            end;
          finally
            Folder := nil;
          end;
        finally
          Malloc.Free(ID);
        end;
      finally
        Desktop := nil;
      end;
    finally
      Malloc := nil;
    end;
end;
...

Никак не могу разобраться, где здесь можно использовать GetUIObjectOf и передавать ItemID?

---

Как можно однозначно идентифицировать виртуальную папку для раскрытия меню? Например, если определять через путь, то Мои Документы будут иметь путь, а Мой Компьютер нет. По названию непонятно, ведь обычная папка тоже может называться Рабочий Стол и т.д....

Автор: Rrader 2.3.2009, 06:33

Keeper89, давайте обговорим несколько вещей...

Цитата(Keeper89 @ 1.3.2009, 23:32

)

где путь я передаю как параметр:

Shell для работы с файловой системой и объектами использует свой особый подход. В них вместо файловых путей используются ItemIDs. Подробности http://msdn.microsoft.com/en-us/library/bb776813(VS.85).aspx
Еще прочитайте http://www.geocities.com/SiliconValley/4942/itemids.html
Затем откройте файл ShellCtrls.pas и посмотрите, как там все реализовано (файл лежит в папке Demos\...\ShellCtrls\ )

Цитата(Keeper89 @ 1.3.2009, 23:32

)

Никак не могу разобраться, где здесь можно использовать GetUIObjectOf и передавать ItemID?

Позле ознакомления с предыдущим материалом таких вопросов уже не должно возникнуть.

Автор: Keeper89 2.3.2009, 15:26

Цитата(Rrader @ 2.3.2009, 06:33

)

Shell для работы с файловой системой и объектами использует свой особый подход. В них вместо файловых путей используются ItemIDs. Подробности здесь
Еще прочитайте это
Затем откройте файл ShellCtrls.pas и посмотрите, как там все реализовано (файл лежит в папке Demos\...\ShellCtrls\ )

Спасибо, разобрался.

Как можно еще сделать 2 вещи:

искать элементы в полученном меню по надписи на нем (для дальнейшего удаления по найденному индексу)?
добавить элементы к своему TPopupMenu?

Автор: Rrader 4.3.2009, 15:50

Цитата(Keeper89 @ 2.3.2009, 21:26

)

искать элементы в полученном меню по надписи на нем (для дальнейшего удаления по найденному индексу)?

Можно использовать Menu API. Но учтите, чтобы это работало при разных локализациях, т.е. используйте метод на свой страх и риск. smile

Если итемы имеют http://msdn.microsoft.com/en-us/library/bb776094(VS.85).aspx имена, то лучше использовать их.

Код


procedure ShowMenuStrings(Menu: HMENU);

  { Universal routine }
  procedure ShowItemText(AMenu: HMENU; AIndex: Integer);
  var
    Info: TMenuItemInfoW;
    Txt: WideString;
  begin
    FillChar(Info, SizeOf(TMenuItemInfoW), 0);
    with Info do
    begin
      fMask := MIIM_FTYPE or MIIM_STRING;
      fType := MFT_STRING;
      cbSize := SizeOf(TMenuItemInfoW);
    end;
    if GetMenuItemInfoW(AMenu, AIndex, True, Info) then
      if Info.fType = MFT_SEPARATOR then
        ShowMessage('-')
      else
      begin
        SetLength(Txt, Info.cch);
        Info.dwTypeData := @Txt[1];
        Inc(Info.cch);
        if GetMenuItemInfoW(AMenu, AIndex, True, Info) then
          ShowMessage(Txt);
      end;
  end;

var
  I: Integer;
begin
  if Menu <> 0 then
    for I := 0 to GetMenuItemCount(Menu) - 1 do
      ShowItemText(Menu, I);
end;

Использование:

Код


...

if Succeeded(CM.QueryContextMenu(Menu, 0, 1,
  UINT(-1), CMF_EXPLORE or CMF_CANRENAME)) then
begin
  { На данном этапе SubMenu еще не созданы }
  ShowMenuStrings(Menu);
  Command := False;

...

Цитата(Keeper89 @ 2.3.2009, 21:26

)

добавить элементы к своему TPopupMenu?

Ну если это настолько необходимо, то вручную, через Menu API. Но я бы делал наоборот - вносил все изменения только в оригинал (Menu в примере). Это сильно упрощает хэндлинг, как выше уже говорил.

Автор: Keeper89 4.3.2009, 21:46

Цитата(Rrader @ 4.3.2009, 15:50

)

Можно использовать Menu API. Но учтите, чтобы это работало при разных локализациях, т.е. используйте метод на свой страх и риск. smile Если итемы имеют канонические имена, то лучше использовать их.

А как можно удалить элемент (с подменю если оно есть)?
Возможно стоит воспользоваться функцией

Код


function AppendMenu(hMenu: HMENU; uFlags, uIDNewItem: UINT; lpNewItem: PChar): BOOL;

с параметром MF_DELETE = $200, определив заранее вашим способом нужный индекс элемента?

Цитата(Rrader @ 4.3.2009, 15:50

)

Как можно реализовать то что вы советуете, если у меня имеются:

названия пунктов меню - String;
стандартные процедуры по их обработке (на OnClick).

Автор: Rrader 5.3.2009, 08:10

Цитата(Keeper89 @ 5.3.2009, 03:46

)

А как можно удалить элемент (с подменю если оно есть)?

Для простоты используйте DeleteMenu:

Код


DeleteMenu(Menu, <Index>, MF_BYPOSITION);

Цитата

If the menu item opens a menu or submenu, this function destroys the handle to the menu or submenu and frees the memory used by the menu or submenu.

Цитата(Keeper89 @ 5.3.2009, 03:46

)

Как можно реализовать то что вы советуете, если у меня имеются:

Для этого есть AppendMenu, InsertMenuItem. При щелчке на итеме главному окну-владельцу посылается сообщение WM_COMMAND.

Автор: Keeper89 5.3.2009, 12:48

Цитата(Rrader @ 5.3.2009, 08:10

)

Для этого есть AppendMenu, InsertMenuItem. При щелчке на итеме главному окну-владельцу посылается сообщение WM_COMMAND.

Прощу прощения. все-таки необходимо вставлять HMENU в свое меню. Дело в том, я использую специальный компонент ToolBar2000, где всплывающее меню имеет дополнительные характеристики по сравнению с дельфийским TPopupMenu.
Как постараться реализовать это?

Автор: Keeper89 11.3.2009, 15:30

Так все-таки как постараться это сделать?

Автор: Rrader 11.3.2009, 16:50

Сорри, забыл про темку smile

С ToolBar2000 знаком...

Что делать - нужно создать процедуру конвертации меню через API, создавать ImageList для меню TB2000, в него динамически добавлять Bitmap'ы из меню Menu (через TBitmap). Меню на основе TB2000 проще создавать и удалять вместе с Menu из примера. Подменю - тут посложнее, так как пока показано основное меню, HandleMenuMsg может вызываться многократно (каждый раз при открытии), что затрудняет преобразование.

Попробуйте написать функцию, а там дальше, если что неясно станет, помогу smile

Пример простейшей конвертации

Код


procedure TForm1.Button1Click(Sender: TObject);

  function GetItemText(AMenu: HMENU; Item: Integer): String;
  var
    Info: TMenuItemInfoW;
  begin
    FillChar(Info, SizeOf(TMenuItemInfoW), 0);
    with Info do
    begin
      fMask := MIIM_FTYPE or MIIM_STRING;
      fType := MFT_STRING;
      cbSize := SizeOf(TMenuItemInfoW);
    end;
    if GetMenuItemInfoW(AMenu, Item, True, Info) then
      if Info.fType = MFT_SEPARATOR then
        Result := '-'
      else
      begin
        SetLength(Result, Info.cch);
        Info.dwTypeData := @Result[1];
        Inc(Info.cch);
        GetMenuItemInfoW(AMenu, Item, True, Info);        
      end;
  end;

var
  TBMenu: TTBPopupMenu;
  NewItem: TTBItem;
  Menu: HMENU;
begin
  Menu := CreateMenu;
  AppendMenuW(Menu, MF_STRING, 0, 'Item1');
  if Menu <> 0 then
  try
    TBMenu := TTBPopupMenu.Create(Self);
    with TBMenu do
    try
      NewItem := TTBItem.Create(TBMenu);
      NewItem.Caption := GetItemText(Menu, 0);
      Items.Add(NewItem);
      Popup(0, 0);
    finally
      Free;
    end;
  finally
    DestroyMenu(Menu);
  end;
end;

Автор: Keeper89 4.11.2009, 01:56

Возобновляю тему 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

Автор: bems 4.11.2009, 22:02

прочтитай цикл, начинающийся http://transl-gunsmoker.blogspot.com/2009/07/icontextmenu-1.html

Автор: Keeper89 5.11.2009, 00:46

bems, давно прочтен smile

Автор: Rrader 5.11.2009, 18:08

Keeper89, выложи тестовый пример с TB, облегчи жизнь желающим помочь smile

Автор: CodeMonkey 5.11.2009, 18:33

WndProc вообще вызывается? И с нужными сообщениями? И интерфейсы не nil?

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

Автор: Keeper89 5.11.2009, 18:59

Rrader, прикрепил проект вместе с EXE.
ToolBar2000 http://www.jrsoftware.org/tb2kdl.php.

Цитата(CodeMonkey @ 5.11.2009, 19:33

)

WndProc вообще вызывается? И с нужными сообщениями?

На счет этого сомневаюсь smile

, т.к., afaik, данные вложенные контекстные меню инициализируются только при попытке их открытии.

Цитата(CodeMonkey @ 5.11.2009, 19:33

)

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

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

Автор: Keeper89 10.11.2009, 13:40

Есть идеи? smile

Автор: CodeMonkey 11.11.2009, 19:59

...мне лениво...