На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Контекстное меню для файла
      Как показать контекстное меню для конкретного файла?

      ExpandedWrap disabled
        ////////////////////////////////////////////////////////////////////////////////
        //
        //  ****************************************************************************
        //  * Unit Name : Unit1
        //  * Purpose   : Демо отображения системного контекстного меню эксплорера
        //  * Author    : Александр (Rouse_) Багель
        //  * Version   : 1.00
        //  ****************************************************************************
        //
         
        unit Unit1;
         
        interface
         
        uses
          Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
          Dialogs, StdCtrls,
          // Чтоб все заработало - подключаем вот эти 2 юнита
          ShlObj,
          ActiveX;
         
        type
          TForm1 = class(TForm)
            Button1: TButton;
            procedure Button1Click(Sender: TObject);
          end;
         
        var
          Form1: TForm1;
         
        implementation
         
        {$R *.dfm}
         
        // Это для работы самого меню, как оконного элемента
        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 TForm1.Button1Click(Sender: TObject);
        var
          pt: TPoint;
        begin
          GetCursorPos(pt);
          GetProperties('E:\Guardant\INSTDRV.INI', pt, Self);
        end;
         
        end.


      Автор: Rouse_
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0196 ]   [ 16 queries used ]   [ Generated: 28.03.24, 10:32 GMT ]