Текущий архив: 2006.05.07;
Скачать: CL | DM;

Вниз

Контекстное меню Проводника   Найти похожие ветки 

← →
Alextp ©   (2006-02-12 11:42) [0]

Нужно вызвать контекстное меню Проводника для заданного имени файла (по нажатию кнопки или еще какому событию) - какие компоненты/библиотеки для этого есть? Вручную работать с интерфейсами Проводника не хочется.

---

← →
Rouse_ ©   (2006-02-12 15:25) [1]

> Вручную работать с интерфейсами Проводника не хочется.

Не хочеться или не можеться? :)

Лови пример:

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * 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.

---

Страницы: 1 вся ветка

Текущий архив: 2006.05.07;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.056 c