Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2006.05.07;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2006.05.07;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.009 c
15-1144757030
DesWind
2006-04-11 16:03
2006.05.07
Мониторинг COM-порта


15-1144990937
Ega23
2006-04-14 09:02
2006.05.07
С Днём рождения! 14 апреля


15-1145179994
mumakil raider
2006-04-16 13:33
2006.05.07
Почему не происходит ошибки?


15-1144903122
BorisMor
2006-04-13 08:38
2006.05.07
Работа в Новосибирске


15-1145135589
Shastox
2006-04-16 01:13
2006.05.07
Старая загадка на новый лад





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский