Оригинал Поиск Дополнительно Вход
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Конференция "KOL" » Отображение системного контекстного меню эксплорера. [Delphi]
 
  • Nikfel © (03.09.07 12:35) [0]
    Пожалуйста помогите перевести код под kol:
    ////////////////////////////////////////////////////////////////////////////////
    //
    //  ****************************************************************************
    //  * Unit Name : uSysPopupMain
    //  * Purpose   : Демо отображения системного контекстного меню эксплорера.
    //  * Author    : Александр (Rouse_) Багель
    //  * Version   : 1.00
    //  ****************************************************************************
    //
    unit uSysPopupMain;

    interface

    uses
     Windows, Messages, SysUtils, Controls,
     ShlObj, ActiveX;

    procedure Set_Explorer_Popup_Menu(pt:TPoint;strName:string;F:TWinControl);

    implementation
    // Это для работы самого меню, как оконного элемента
    function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM;
    LParam: LPARAM): LRESULT; stdcall;
    var
     ContextMenu2: IContextMenu2;
    begin
     case Msg of
       WM_CREATE:
       begin
         ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
         SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));
         Result := DefWindowProc(Wnd, Msg, wParam, lParam);
       end;
       WM_INITMENUPOPUP:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 0;
       end;
       WM_DRAWITEM, WM_MEASUREITEM:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 1;
       end;
     else
       Result := DefWindowProc(Wnd, Msg, wParam, lParam);
     end;
    end;

    // Это для создания самого меню, как оконного элемента
    function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND;
    const
     IcmCallbackWnd = 'ICMCALLBACKWND';
    var
     WndClass: TWndClass;
    begin
     FillChar(WndClass, SizeOf(WndClass), #0);
     WndClass.lpszClassName := PChar(IcmCallbackWnd);
     WndClass.lpfnWndProc := @MenuCallback;
     WndClass.hInstance := HInstance;
     Windows.RegisterClass(WndClass);
     Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0,
       0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu));
    end;

    procedure GetProperties(Path: String; MousePoint: TPoint; WC: TWinControl);
    var
     CoInit, AResult: HRESULT;
     CommonDir, FileName: String;
     Desktop, ShellFolder: IShellFolder;
     pchEaten, Attr: Cardinal;
     PathPIDL: PItemIDList;
     FilePIDL: array [0..1] of PItemIDList;
     ShellContextMenu: HMenu;
     ICMenu: IContextMenu;
     ICMenu2: IContextMenu2;
     PopupMenuResult: BOOL;
     CMD: TCMInvokeCommandInfo;
     M: IMAlloc;
     ICmd: Integer;
     CallbackWindow: HWND;
    begin
     // Первичная инициализация
     ShellContextMenu := 0;
     Attr := 0;
     PathPIDL := nil;
     CallbackWindow := 0;
     CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED);
     try
       // Получаем пути и имя фала
       CommonDir := ExtractFilePath(Path);
       FileName := ExtractFileName(Path);
       // Получаем указатель на интерфейс рабочего стола
       if SHGetDesktopFolder(Desktop) <> S_OK then
         RaiseLastOSError;
       // Если работаем с папкой
       if FileName = '' then
       begin
         // Получаем указатель на папку "Мой компьютер"
         if (SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PathPIDL) <> S_OK) or
           (Desktop.BindToObject(PathPIDL,  nil,  IID_IShellFolder,
             Pointer(ShellFolder)) <> S_OK) then RaiseLastOSError;
         // Получаем указатель на директорию
         ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),
           pchEaten, FilePIDL[0], Attr);
         // Получаем указатель на контектсное меню папки
         AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],
           IID_IContextMenu, nil, Pointer(ICMenu));
       end
       else
       begin
         // Получаем указатель на папку "Мой компьютер"
         if (Desktop.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),
           pchEaten, PathPIDL, Attr) <> S_OK) or
           (Desktop.BindToObject(PathPIDL, nil, IID_IShellFolder,
             Pointer(ShellFolder)) <> S_OK) then RaiseLastOSError;
         // Получаем указатель на файл
         ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(FileName),
           pchEaten, FilePIDL[0], Attr);
         // Получаем указатель на контектсное меню файла
         AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],
           IID_IContextMenu, nil, Pointer(ICMenu));
       end;

       // Если указатель на конт. меню есть, делаем так:
       if Succeeded(AResult) then
       begin
         ICMenu2 := nil;
         // Создаем меню
         ShellContextMenu := CreatePopupMenu;
         // Производим его наполнение
         if Succeeded(ICMenu.QueryContextMenu(ShellContextMenu, 0,
           1, $7FFF, CMF_EXPLORE)) and
           Succeeded(ICMenu.QueryInterface(IContextMenu2, ICMenu2)) then
             CallbackWindow := CreateMenuCallbackWnd(ICMenu2);
         try
           // Показываем меню
           PopupMenuResult := TrackPopupMenu(ShellContextMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON
             or TPM_RIGHTBUTTON or TPM_RETURNCMD,
             MousePoint.X, MousePoint.Y, 0, CallbackWindow, nil);
         finally
           ICMenu2 := nil;
         end;
         // Если был выбран какой либо пункт меню:
         if PopupMenuResult then
         begin
           // Индекс этого пункта будет лежать в ICmd
           ICmd := LongInt(PopupMenuResult) - 1;
           // Заполняем структуру TCMInvokeCommandInfo
           FillChar(CMD, SizeOf(CMD), #0);
           with CMD do
           begin
             cbSize := SizeOf(CMD);
             hWND := WC.Handle;
             lpVerb := MakeIntResource(ICmd);
             nShow := SW_SHOWNORMAL;
           end;
           // Выполняем InvokeCommand с заполненной структурой
           AResult := ICMenu.InvokeCommand(CMD);
           if AResult <> S_OK then RaiseLastOSError;
          end;
       end;
     finally
       // Освобождаем занятые ресурсы чтобы небыло утечки памяти
       if FilePIDL[0] <> nil then
       begin
         // Для освобождения использем IMalloc
         SHGetMAlloc(M);
         if M <> nil then
           M.Free(FilePIDL[0]);
         M:=nil;
       end;
       if PathPIDL <> nil then
       begin
         SHGetMAlloc(M);
         if M <> nil then
           M.Free(PathPIDL);
         M:=nil;
       end;
       if ShellContextMenu <>0 then
         DestroyMenu(ShellContextMenu);
       if CallbackWindow <> 0 then
         DestroyWindow(CallbackWindow);
       ICMenu := nil;
       ShellFolder := nil;
       Desktop := nil;
       if CoInit = S_OK then CoUninitialize;
     end;
    end;

    procedure Set_Explorer_Popup_Menu(pt:TPoint;strName:string;F:TWinControl);
    begin
     GetProperties(strName, pt, F);
    end;

    end.

    Пример работы в:
    http://www.delphisources.ru/files/sources/system/2006_year/expl_popup_menu.zip
  • Дмитрий К © (03.09.07 13:42) [1]
    program KOLSysPopup;

    uses
     windows, messages, kol,
     ShlObj, ActiveX;

    type
     PForm1 = ^TForm1;
     TForm1 = object(TObj)
       form, lbl, edt, btn: PControl;
     public
       procedure DoClick(Sender: PObj);
     end;

    var Form1: PForm1;

    procedure NewForm1(var Result: PForm1; AParent: PControl);
    begin
     New(Result, Create);
     with Result^ do
     begin
       form := NewForm(AParent, 'popup');
       Applet := form;
       form.add2AutoFree(Result);
       lbl := NewLabel(form,'Enter path').AutoSize(True);
       edt := NewEditBox(form, []).SetSize(300,0).PlaceUnder;
       edt.text := 'c:\';
       btn := NewButton(form, 'Show').PlaceRight.ResizeParent;
       btn.OnClick := DoClick;
     end;
    end;

    //**********
    function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM;
    LParam: LPARAM): LRESULT; stdcall;
    var
     ContextMenu2: IContextMenu2;
    begin
     case Msg of
       WM_CREATE:
       begin
         ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
         SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));
         Result := DefWindowProc(Wnd, Msg, wParam, lParam);
       end;
       WM_INITMENUPOPUP:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 0;
       end;
       WM_DRAWITEM, WM_MEASUREITEM:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 1;
       end;
     else
       Result := DefWindowProc(Wnd, Msg, wParam, lParam);
     end;
    end;

    function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND;
    const
     IcmCallbackWnd = 'ICMCALLBACKWND';
    var
     WndClass: TWndClass;
    begin
     FillChar(WndClass, SizeOf(WndClass), #0);
     WndClass.lpszClassName := PChar(IcmCallbackWnd);
     WndClass.lpfnWndProc := @MenuCallback;
     WndClass.hInstance := HInstance;
     Windows.RegisterClass(WndClass);
     Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0,
       0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu));
    end;

    procedure GetProperties(Path: String; MousePoint: TPoint; WC: PControl);
    var
     CoInit, AResult: HRESULT;
     CommonDir, FileName: String;
     Desktop, ShellFolder: IShellFolder;
     pchEaten, Attr: Cardinal;
     PathPIDL: PItemIDList;
     FilePIDL: array [0..1] of PItemIDList;
     ShellContextMenu: HMenu;
     ICMenu: IContextMenu;
     ICMenu2: IContextMenu2;
     PopupMenuResult: BOOL;
     CMD: TCMInvokeCommandInfo;
     M: IMAlloc;
     ICmd: Integer;
     CallbackWindow: HWND;
    begin
     ShellContextMenu := 0;
     Attr := 0;
     PathPIDL := nil;
     CallbackWindow := 0;
     CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED);
     try
       CommonDir := ExtractFilePath(Path);
       FileName := ExtractFileName(Path);
       if SHGetDesktopFolder(Desktop) <> S_OK then
         msgok(SysErrorMessage(GetLastError));
       if FileName = '' then
       begin
         if (SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PathPIDL) <> S_OK) or
           (Desktop.BindToObject(PathPIDL,  nil,  IID_IShellFolder,
             Pointer(ShellFolder)) <> S_OK) then
           msgok(SysErrorMessage(GetLastError));
         ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),
           pchEaten, FilePIDL[0], Attr);
         AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],
           IID_IContextMenu, nil, Pointer(ICMenu));
       end
       else
       begin
         if (Desktop.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),
           pchEaten, PathPIDL, Attr) <> S_OK) or
           (Desktop.BindToObject(PathPIDL, nil, IID_IShellFolder,
             Pointer(ShellFolder)) <> S_OK) then
           msgok(SysErrorMessage(GetLastError));
         ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(FileName),
           pchEaten, FilePIDL[0], Attr);
         AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],
           IID_IContextMenu, nil, Pointer(ICMenu));
       end;
       if Succeeded(AResult) then
       begin
         ICMenu2 := nil;
         ShellContextMenu := CreatePopupMenu;
         if Succeeded(ICMenu.QueryContextMenu(ShellContextMenu, 0,
           1, $7FFF, CMF_EXPLORE)) and
           Succeeded(ICMenu.QueryInterface(IContextMenu2, ICMenu2)) then
             CallbackWindow := CreateMenuCallbackWnd(ICMenu2);
         try
           PopupMenuResult := TrackPopupMenu(ShellContextMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON
             or TPM_RIGHTBUTTON or TPM_RETURNCMD,
             MousePoint.X, MousePoint.Y, 0, CallbackWindow, nil);
         finally
           ICMenu2 := nil;
         end;
         if PopupMenuResult then
         begin
           ICmd := LongInt(PopupMenuResult) - 1;
           FillChar(CMD, SizeOf(CMD), #0);
           with CMD do
           begin
             cbSize := SizeOf(CMD);
             hWND := WC.Handle;
             lpVerb := MakeIntResource(ICmd);
             nShow := SW_SHOWNORMAL;
           end;
           AResult := ICMenu.InvokeCommand(CMD);
           if AResult <> S_OK then
             msgok(SysErrorMessage(GetLastError));
          end;
       end;
     finally
       if FilePIDL[0] <> nil then
       begin
         SHGetMAlloc(M);
         if M <> nil then
           M.Free(FilePIDL[0]);
         M:=nil;
       end;
       if PathPIDL <> nil then
       begin
         SHGetMAlloc(M);
         if M <> nil then
           M.Free(PathPIDL);
         M:=nil;
       end;
       if ShellContextMenu <>0 then
         DestroyMenu(ShellContextMenu);
       if CallbackWindow <> 0 then
         DestroyWindow(CallbackWindow);
       ICMenu := nil;
       ShellFolder := nil;
       Desktop := nil;
       if CoInit = S_OK then CoUninitialize;
     end;
    end;
    //***********

    procedure TForm1.DoClick(Sender: PObj);
    var
     pt: TPoint;
    begin
     GetCursorPos(pt);
     GetProperties(edt.Text, pt, form);
    end;

    begin
     NewForm1(Form1, nil);
     Run(Applet);
    end.

  • Nikfel © (03.09.07 17:00) [2]
    Проверил код. Он работает, но почему-то в пункте отправить программа виснет.
  • Nikfel © (03.09.07 17:11) [3]
    За код спасибо. Кто-нибудь может сказать как спрятать пункт отправить, а то у меня программа виснет.
  • Nikfel © (03.09.07 17:34) [4]
    Нашел способ как избавиться от пункта отправить. Надо удалить:
    HKEY_CLASSES_ROOT\AllFilesystemObjects\shellex\ContextMenuHandlers\Send To
    Но может есть что-то по лудше. Этот способ не удобен.
  • Nikfel © (04.09.07 14:54) [5]
    Нашел в интернете отличный код:
    unit Unit2;

    interface

    uses Windows, ActiveX, ShlObj, Messages, kol;

    function DisplayContextMenu(const Handle: HWND; const FileName: string; Pos: TPoint): Boolean;

    implementation

    // Window procedure for the callback window created by DisplayContextMenu.
    // It simply forwards messages to the folder. If you don't do this then the
    // system created submenu's will be empty (except for 1 stub item!)
    // note: storing the IContextMenu2 pointer in the window's user data was
    // 'inspired' by (read: copied from) code by Brad Stowers.

    function MenuCallback(Wnd: HWND; Msg: UINT; wParam: WPARAM;
     lParam: LPARAM): LRESULT; stdcall;
    var
     ContextMenu2: IContextMenu2;
    begin
     case Msg of
       WM_CREATE:
         begin
           ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
           SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));
           Result := DefWindowProc(Wnd, Msg, wParam, lParam);
         end;
       WM_INITMENUPOPUP:
         begin
           ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
           ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
           Result := 0;
         end;
       WM_DRAWITEM, WM_MEASUREITEM:
         begin
           ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
           ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
           Result := 1;
         end;
     else
       Result := DefWindowProc(Wnd, Msg, wParam, lParam);
     end;
    end;

    //------------------------------------------------------------------------------

    // Helper function for DisplayContextMenu, creates the callback window.

    function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND;
    const
     IcmCallbackWnd = 'ICMCALLBACKWND';
    var
     WndClass: TWndClass;
    begin
     FillChar(WndClass, SizeOf(WndClass), #0);
     WndClass.lpszClassName := PChar(IcmCallbackWnd);
     WndClass.lpfnWndProc := @MenuCallback;
     WndClass.hInstance := HInstance;
     Windows.RegisterClass(WndClass);
     Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0,
       0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu));
    end;

    //------------------------------------------------------------------------------

    function DisplayContextMenuPidl(const Handle: HWND; const Folder: IShellFolder;
     Item: PItemIdList; Pos: TPoint): Boolean;
    var
     Cmd: Cardinal;
     ContextMenu: IContextMenu;
     ContextMenu2: IContextMenu2;
     Menu: HMENU;
     CommandInfo: TCMInvokeCommandInfo;
     CallbackWindow: HWND;
    begin
     Result := False;
     // TODO If Folder = nil then PidlBindToParent ?
     if (Item = nil) or (Folder = nil) then
       Exit;
     Folder.GetUIObjectOf(Handle, 1, Item, IID_IContextMenu, nil,
       Pointer(ContextMenu));
     if ContextMenu <> nil then
     begin
       Menu := CreatePopupMenu;
       if Menu <> 0 then
       begin
         if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
         begin
           CallbackWindow := 0;
           if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then
           begin
             CallbackWindow := CreateMenuCallbackWnd(ContextMenu2);
           end;
           ClientToScreen(Handle, Pos);
           Cmd := Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
             TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X, Pos.Y, 0, CallbackWindow, nil));
           if Cmd <> 0 then
           begin
             FillChar(CommandInfo, SizeOf(CommandInfo), #0);
             CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo);
             CommandInfo.hwnd := Handle;
             CommandInfo.lpVerb := MakeIntResource(Cmd - 1);
             CommandInfo.nShow := SW_SHOWNORMAL;
             Result := Succeeded(ContextMenu.InvokeCommand(CommandInfo));
           end;
           if CallbackWindow <> 0 then
             DestroyWindow(CallbackWindow);
         end;
         DestroyMenu(Menu);
       end;
     end;
    end;

    //------------------------------------------------------------------------------

    function PathAddSeparator(Folder: string):string;
    begin
       result := Folder + '\';
    end;

    function PidlFree(var IdList: PItemIdList): Boolean;
    var
     Malloc: IMalloc;
    begin
     Result := False;
     if IdList = nil then
       Result := True
     else
     begin
       if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
       begin
         Malloc.Free(IdList);
         IdList := nil;
         Result := True;
       end;
     end;
    end;

    function DriveToPidlBind(const DriveName: string;
     out Folder: IShellFolder): PItemIdList;
    var
     Attr: ULONG;
     Eaten: ULONG;
     DesktopFolder: IShellFolder;
     Drives: PItemIdList;
     Path: array [0..MAX_PATH] of WideChar;
    begin
     Result := nil;
     if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
     begin
       if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)) then
       begin
         if Succeeded(DesktopFolder.BindToObject(Drives, nil, IID_IShellFolder,
           Pointer(Folder))) then
         begin
           MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(PathAddSeparator(DriveName)), -1, Path, MAX_PATH);
           if FAILED(Folder.ParseDisplayName(0, nil, Path, Eaten, Result,
             Attr)) then
           begin
             Folder := nil;
             // Failure probably means that this is not a drive. However, do not
             // call PathToPidlBind() because it may cause infinite recursion.
           end;
         end;
       end;
       PidlFree(Drives);
     end;
    end;

    function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList;
    var
     Attr, Eaten: ULONG;
     PathIdList: PItemIdList;
     DesktopFolder: IShellFolder;
     Path, ItemName: array [0..MAX_PATH] of WideChar;
    begin
     Result := nil;
     MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(ExtractFilePath(FileName)), -1, Path, MAX_PATH);
     MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(ExtractFileName(FileName)), -1, ItemName, MAX_PATH);
     if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
     begin
       if Succeeded(DesktopFolder.ParseDisplayName(0, nil, Path, Eaten, PathIdList,
         Attr)) then
       begin
         if Succeeded(DesktopFolder.BindToObject(PathIdList, nil, IID_IShellFolder,
           Pointer(Folder))) then
         begin
           if FAILED(Folder.ParseDisplayName(0, nil, ItemName, Eaten, Result,
             Attr)) then
           begin
             Folder := nil;
             Result := DriveToPidlBind(FileName, Folder);
           end;
         end;
         PidlFree(PathIdList);
       end
       else
         Result := DriveToPidlBind(FileName, Folder);
     end;
    end;

    function DisplayContextMenu(const Handle: HWND; const FileName: string;
     Pos: TPoint): Boolean;
    var
     ItemIdList: PItemIdList;
     Folder: IShellFolder;
    begin
     Result := False;
     ItemIdList := PathToPidlBind(FileName, Folder);
     if ItemIdList <> nil then
     begin
       Result := DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos);
       PidlFree(ItemIdList);
     end;
    end;

    end.
  • MTsv DN © (18.09.07 16:36) [6]
    Привет.

    Решил снова поднять данную тему. Все три кода показывают, как я понял, стандартное меню Проводника, то которое мы имеем сразу после установки Винды. Однако, на сайте Уважаемого Александра (Rouse_) Багеля (см. [0], есть новый код в котором используется COM-объекты для отображения полного меню Проводника (с архиваторами, антивирусами и прочими).

    Начал портировать под KOL и столкнулся со следующей проблемой: http://slil.ru/24871648 Как видно, используются одни и те же юниты и код...однако, в случае использования KOL мы не получаем желаемого результата... Отсюда вопрос: Почему???

    З.Ы. То, что используются SysUtils и Classes мне без разницы...
  • ANTPro © (18.09.07 17:13) [7]
    > [6] MTsv DN ©   (18.09.07 16:36)

    Попробуй юзать не KOLComObj, а стандартный ComObj.
    PS: Архив не смотрел еще.
  • MTsv DN © (18.09.07 17:48) [8]
    > Попробуй юзать не KOLComObj, а стандартный ComObj
    Пробовал...не помогает. Тем более, что не-KOL версия и с KOLComObj
    правильно работает...
  • MTsv DN © (19.09.07 10:10) [9]
    Привет.

    > Решил снова поднять данную тему. Все три кода показывают, как я понял, стандартное меню Проводника, то которое мы имеем сразу после установки Винды. Однако, на сайте Уважаемого Александра (Rouse_) Багеля (см. [0], есть новый код в котором используется COM-объекты для отображения полного меню Проводника (с архиваторами, антивирусами и прочими).
    >
    > Начал портировать под KOL и столкнулся со следующей проблемой:  http://slil.ru/24871648 Как видно, используются одни и те же юниты и код...однако, в случае использования KOL мы не получаем желаемого результата... Отсюда вопрос: Почему???
    >
    > З.Ы. То, что используются SysUtils и Classes мне без разницы...
    Наконец-то разобрался где "косячило"... Вот минимальный проект: http://ifolder.ru/3398396
  • Дмитрий К © (19.09.07 12:39) [10]

    > Наконец-то разобрался где "косячило"... Вот минимальный
    > проект: http://ifolder.ru/3398396

    +1

    В связи с этим, чтобы заработал код из [1] нужно поменять
     CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED);


    на
     CoInit := CoInitializeEx(nil, COINIT_APARTMENTTHREADED);

  • Nikfel © (19.09.07 18:30) [11]
    Большое спасибо за код. Для работы кода похоже требуется err.pas, который пришлось скачать с http://kolmck.net/
  • MTsv DN © (22.09.07 14:37) [12]
    Всем привет...

    Этот код:
    > http://ifolder.ru/3398396
    прекрасно работает если передавать один элемент, например, полный путь к файлу. Но ведь можно передавать группу элементов, как поступать в этом случае??? Подскажите...
  • MTsv DN © (26.09.07 15:36) [13]
    Всем привет...

    > прекрасно работает если передавать один элемент, например, полный путь к файлу. Но ведь можно передавать группу элементов, как поступать в этом случае??? Подскажите...
    В заключение темы, отвечу на свой вопрос сам:

    (*======================================================================== ====*)
    // Это для работы самого меню, как оконного элемента
    function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM;
    LParam: LPARAM): LRESULT; stdcall;
    var
     ContextMenu2: IContextMenu2;
    begin
     case Msg of
       WM_CREATE:
       begin
         ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
         SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));
         Result := DefWindowProc(Wnd, Msg, wParam, lParam);
       end;
       WM_INITMENUPOPUP:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 0;
       end;
       WM_DRAWITEM, WM_MEASUREITEM:
       begin
         ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
         ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
         Result := 1;
       end;
     else
       Result := DefWindowProc(Wnd, Msg, wParam, lParam);
     end;
    end;

  • MTsv DN © (26.09.07 15:37) [14]
    // Это для создания самого меню, как оконного элемента
    function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND;
    const
     IcmCallbackWnd = 'ICMCALLBACKWND';
    var
     WndClass: {$IFDEF UNICODE_CTRLS}TWndClassW{$ELSE}TWndClassA{$ENDIF};
    begin
     FillChar(WndClass, SizeOf(WndClass), #0);
     WndClass.lpszClassName := PKOLChar(KOLString(IcmCallbackWnd));
     WndClass.lpfnWndProc := @MenuCallback;
     WndClass.hInstance := HInstance;
     {Windows.}{$IFDEF UNICODE_CTRLS}RegisterClassW{$ELSE}RegisterClassA{$ENDIF}(WndClass);
     Result := {$IFDEF UNICODE_CTRLS}CreateWindowW{$ELSE}CreateWindowA{$ENDIF}
               (IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0, 0, 0, 0, 0, 0,
               HInstance, Pointer(ContextMenu));
    end;

    procedure GetProperties(Paths : {$IFDEF UNICODE_CTRLS}PWStrList{$ELSE}PStrList{$ENDIF}; MousePoint: TPoint; WC: HWND);
    var
     CoInit, AResult: HRESULT;
     CommonDir, FileName: KOLString;
     Desktop, ShellFolder: IShellFolder;
     pchEaten, Attr: Cardinal;
     PathPIDL: PItemIDList;
     FilePIDL: array of PItemIDList;
     ShellContextMenu: HMenu;
     ICMenu: IContextMenu;
     ICMenu2: IContextMenu2;
     PopupMenuResult: BOOL;
     CMD: TCMInvokeCommandInfo;
     M: IMAlloc;
     ICmd: Integer;
     CallbackWindow: HWND;

     S : KOLString;
     i : integer;
    begin
     // Первичная инициализация
     ShellContextMenu := 0;
     Attr := 0;
     PathPIDL := nil;
     CallbackWindow := 0;
     CoInit := CoInitialize{Ex}(nil);//, COINIT_MULTITHREADED);  
     try
       // Получаем пути и имя фала
       SetLength(FilePIDL, 0);
       CommonDir := ExtractFilePath(Paths.Items[0]);
       FileName := ExtractFileName(Paths.Items[0]);
       // Получаем указатель на интерфейс рабочего стола
       if SHGetDesktopFolder(Desktop) <> S_OK then
         RaiseLastWin32Error;
       // Если работаем с папкой
       if FileName = '' then
       begin
         // Получаем указатель на папку "Мой компьютер"
         if (SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PathPIDL) <> S_OK) or
           (Desktop.BindToObject(PathPIDL,  nil,  IID_IShellFolder,
             Pointer(ShellFolder)) <> S_OK) then
              RaiseLastWin32Error;

         SetLength(FilePIDL, 1);
         // Получаем указатель на директорию
         if CommonDir <> '' then
          if CommonDir[Length(CommonDir)] <> '\' then
           CommonDir := CommonDir + '\';
         ShellFolder.ParseDisplayName(WC, nil, StringToOleStr(CommonDir),
           pchEaten, FilePIDL[0], Attr);
         // Получаем указатель на контектсное меню папки
         AResult := ShellFolder.GetUIObjectOf(WC, 1, FilePIDL[0],
           IID_IContextMenu, nil, Pointer(ICMenu));
       end
       else
       begin
         // Получаем указатель на папку "Мой компьютер"
         if (Desktop.ParseDisplayName(WC, nil, StringToOleStr(CommonDir), pchEaten, PathPIDL, Attr) <> S_OK) or
            (Desktop.BindToObject(PathPIDL, nil, IID_IShellFolder, Pointer(ShellFolder)) <> S_OK) then
              RaiseLastWin32Error;

         for i := 0 to Paths.Count - 1 do
          begin
           S := ExtractFileName(Paths.Items[i]);
           if S <> '' then
            begin
             SetLength(FilePIDL, i+1);
             // Получаем указатель на файл
             ShellFolder.ParseDisplayName(WC, nil, StringToOleStr(S), pchEaten,
                                          FilePIDL[i], Attr);
             // Получаем указатель на контектсное меню файла
            end;
          end;
         AResult := ShellFolder.GetUIObjectOf(WC, Paths.Count, FilePIDL[0],
                    IID_IContextMenu, nil, Pointer(ICMenu));
       end;

       // Если указатель на конт. меню есть, делаем так:
       if Succeeded(AResult) then
       begin
         ICMenu2 := nil;
         // Создаем меню
         ShellContextMenu := CreatePopupMenu;

         // Производим его наполнение
         if Succeeded(ICMenu.QueryContextMenu(ShellContextMenu, 0,
           1, $7FFF, CMF_CANRENAME or CMF_EXPLORE)) and
           Succeeded(ICMenu.QueryInterface(IContextMenu2, ICMenu2)) then
             CallbackWindow := CreateMenuCallbackWnd(ICMenu2);
         try
           // Показываем меню
           PopupMenuResult := TrackPopupMenu(ShellContextMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON
             or TPM_RIGHTBUTTON or TPM_RETURNCMD,
             MousePoint.X, MousePoint.Y, 0, CallbackWindow, nil);
         finally
           ICMenu2 := nil;
         end;
         // Если был выбран какой либо пункт меню:
         if PopupMenuResult then
         begin
           // Индекс этого пункта будет лежать в ICmd
           ICmd := LongInt(PopupMenuResult) - 1;

           if ICmd = 18 then
    ////         Здесь код для пункта "Переименовать"
    ////         SendMessage(ListView.Handle, LVM_EDITLABEL, ListView.LVCurItem, 0)
             else
              begin
               // Заполняем структуру TCMInvokeCommandInfo
               FillChar(CMD, SizeOf(CMD), #0);
               with CMD do
                begin
                 cbSize := SizeOf(CMD);
                 hWND := WC;
                 lpVerb := MakeIntResourceA(ICmd);
                 nShow := SW_SHOWNORMAL;
                end;
               // Выполняем InvokeCommand с заполненной структурой
               AResult := ICMenu.InvokeCommand(CMD);
               if AResult <> S_OK then
                RaiseLastWin32Error;
              end;
           SetForegroundWindow( Form.Handle);
          end;
       end;
     finally
       // Освобождаем занятые ресурсы чтобы небыло утечки памяти
       if FilePIDL[0] <> nil then
       begin
         // Для освобождения использем IMalloc
         SHGetMAlloc(M);
         if M <> nil then
          for i := 0 to Length(FilePIDL) - 1 do
           M.Free(FilePIDL[i]);
         M := nil;
         SetLength(FilePIDL, 0);
       end;
       if PathPIDL <> nil then
       begin
         SHGetMAlloc(M);
         if M <> nil then
           M.Free(PathPIDL);
         M := nil;
       end;
       if ShellContextMenu <>0 then
         DestroyMenu(ShellContextMenu);
       if CallbackWindow <> 0 then
         DestroyWindow(CallbackWindow);
       ICMenu := nil;
       ShellFolder := nil;
       Desktop := nil;
       if CoInit = S_OK then CoUninitialize;
     end;
    end;
    (*============================================================================*)

    Вот так. Теперь думаю, эту тему и http://pda.delphimaster.net/?id=1190391967&n=10 можно закрывать... Огромное спасибо Rouse_, non и mdw
  • Nikfel © (01.10.07 11:20) [15]
    Никак не могу разобраться с последним кодом. Правильно ли я делаю: я заменяю код в ExplorerMenu.pas на указанный выше,но при этом программа не запускается  и не работает. Подскажите в чем моя ошибка. Не могу понять в чем дело. Как вывести меню для группы элементов, для этого надо как-то отделить файловые пути. А для этого надо использовать ";" или что?
  • MTsv DN © (01.10.07 14:11) [16]
    > Как вывести меню для группы элементов, для этого надо как-то отделить файловые пути. А для этого надо использовать ";" или что?

    procedure GetProperties(Paths : {$IFDEF UNICODE_CTRLS}PWStrList{$ELSE}PStrList{$ENDIF}; MousePoint: TPoint; WC: HWND);



    В OnClick, заполняешь (W)StrList и передаешь в GetProperties.
  • Nikfel © (01.10.07 18:58) [17]
    Пришлось убрать:
    SetForegroundWindow( Form.Handle);
    CMF_CANRENAME
    Из-за этого код не работал.
    Обязательны ли эти пункты и каково должно быть значение
    const CMF_CANRENAME.
  • MTsv DN © (01.10.07 20:28) [18]

    > SetForegroundWindow( Form.Handle);

    Это нет... Это от моего осталось.


    > CMF_CANRENAME

    В сист.меню появляется пункт "Переименовать" обрабатывается здесь:
          if ICmd = 18 then
    ////         Здесь код для пункта "Переименовать"
    ////         SendMessage(ListView.Handle, LVM_EDITLABEL, ListView.LVCurItem, 0)
            else

  • Nikfel © (02.10.07 10:07) [19]
    Правильно ли я задал значение для const
    CMF_CANRENAME           = $00000010;
    При этом значении пункт переименовать появляется.
    Интересно, а каким образом можно добавить  в такое меню свой пункт, например пункт добавить и т.п. ?
    Возможно ли отобразить свойства файлов для двух дисков, только со вкладкой общие?
  • Nikfel © (11.10.07 19:59) [20]
    Добавить пункт к системному меню можно используя:
    procedure TForm1.KOLForm1FormCreate(Sender: PObj);
    begin
    insertmenu(GetSystemMenu(Form.Handle, FALSE), 0, mf_string or mf_byposition, 0,'Действие');
    insertmenu(GetSystemMenu(Form.Handle, FALSE), 1,mf_byposition or MF_SEPARATOR, 1,'');
    end;

    function TForm1.KOLForm1Message(var Msg: tagMSG;
     var Rslt: Integer): Boolean;
    begin
    Result := FALSE;
     if  (Msg.message = WM_SYSCOMMAND)
     and (Msg.hwnd = Form.Handle) then
     begin
       if Msg.wParam = 0 then
       ShowMessage('Был нажат наш пункт меню!!!');
    end;
    end;
    Взято: http://www.dotfix.net/module.php?module=@6e786b366a6a70736a6a5f7277705b685f676d
    Но никак не получается обработать нажатие на добавленный пункт в ShellContextMenu.
    Добавляю так:
    Вставляю этот код в указанный выше.
    // Показываем меню
    insertmenu(ShellContextMenu, 0, mf_string or mf_byposition, 0,'Действие');
    insertmenu(ShellContextMenu, 1,mf_byposition or MF_SEPARATOR, 1,'');
    SetMenuDefaultItem(ShellContextMenu,0,0); //жирным шрифтом.
    Подскажите пожалуйста, что я делаю не так? И точно также делаю обработку сообщения, но почему-то не работает.
 
Конференция "KOL" » Отображение системного контекстного меню эксплорера. [Delphi]
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Есть новые Нет новых   [134431   +10][b:0.001][p:0.005]