VPF::Контекстное меню как у проводника.

Rohoss

Дата 31.1.2009, 05:51 (ссылка)

(нет голосов)

Загрузка ...

Начальник интернета

Профиль
Группа: Завсегдатай
Сообщений: 1308
Регистрация: 9.10.2006
Где: Matrix

Репутация: 4
Всего: 18

Как реализовать сабж в своём приложении, по аналогии например тотал-командера? Контекстное меню к своим «итемам» как к файлам в проводнике. Ну и естественно передать потом команду реальному файлу (например: удаления, копирования и тд.)

--------------------

Файловый менеджер Explorer.Net скачать video

ZBugz

Дата 31.1.2009, 09:24 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

Репутация: 6
Всего: 6

PopupMenu

Rrader

Дата 31.1.2009, 10:48 (ссылка)

(голосов:1)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

Rohoss, находишь в демках (папка Demos в каталоге Delphi) пример на использование ShellControls. Там лежит файл ShellCtrls.pas - в нем есть

Код


procedure InvokeContextMenu(Owner: TWinControl; AFolder: TShellFolder; X, Y: Integer);

Изучаешь, как она работает. Придется изучить шелловые интерфейсы, но там все до безобразия просто smile

Если по ходу возникнут вопросы, пиши smile

--------------------

Let's do this quickly!
Rest in peace, Vit!

Rohoss

Дата 31.1.2009, 21:40 (ссылка)

(нет голосов)

Загрузка ...

Начальник интернета

Профиль
Группа: Завсегдатай
Сообщений: 1308
Регистрация: 9.10.2006
Где: Matrix

Репутация: 4
Всего: 18

Rrader, спасибо! А вот(в аттаче) ещё пример в сети нашёл, автор указан в файле модуля.

Присоединённый файл ( Кол-во скачиваний: 12 )

expl_popup_menu.zip 11,22 Kb

--------------------

Файловый менеджер Explorer.Net скачать video

GN1

Дата 2.2.2009, 17:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 23.4.2008
Где: Казахстан

Репутация: нет
Всего: нет

Имеется такая DLL'ка:

Код


unit MyUnit;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, Dialogs;

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFileName: array[0..MAX_PATH] of Char;
  protected
    { IShellExtInit }
    function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
    function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
      hKeyProgID: HKEY): HResult; stdcall;
    { IContextMenu }
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
      uFlags: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  end;

const
  Class_ContextMenu: TGUID = '{EBAF9F47-C849-45D1-5747-0891AB3E75A4}';
  MaxPath = 65000;

var
  PathSysDir: Array[0..MaxPath] of Char;

implementation

uses ComServ, SysUtils, ShellApi, Registry;

// Тут наше меню инициализируется
// на вход приходит интерфейс IDataObject из которого мы можем получить
// список файлов и папок над которыми будут происходить действия
function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
begin
  // Fail the call if lpdobj is Nil.
  if (lpdobj = nil) then begin
    Result := E_INVALIDARG;
    Exit;
  end;

  with FormatEtc do begin
    cfFormat := CF_HDROP;
    ptd      := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex   := -1;
    tymed    := TYMED_HGLOBAL;
  end;

  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;
  // If only one file is selected, retrieve the file name and store it in
  // FFileName. Otherwise fail the call.
  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
    Result := NOERROR;
  end
  else begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
  ReleaseStgMedium(StgMedium);
end;


// Создание меню:
// по этому событию мы добавляем новые элементы меню...
function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  Result := 0; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);

  if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) then
  begin
    // Add one menu item to context menu
    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'Текст контекстного меню');

    // Return number of menu items added
    Result := 1; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 1)
  end;
end;


// данная функция срабатывает при нажатии на наш элемент меню
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
resourcestring
  sPathError = 'Error setting current directory';
var
  st: string;
  Path: string;
begin
  GetSystemDirectory(PathSysDir, MaxPath);
  Path := string(PathSysDir);
  Path := Path + '\MyProgram.exe';
  st := string(FFileName);
  st := '"' + st + '"';
  ShellExecute(0, nil, PChar(Path), PChar(st), nil, SW_SHOW);
end;


// Данная функция вызывается когда статус бар в эксплорере активен
// и в нем отображается краткая информация о подсвеченном пункте меню
function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if (idCmd = 0) then begin
    if (uType = GCS_HELPTEXT) then
      // return help string for menu item
      StrCopy(pszName, 'Ыть');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;


procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('*\shellex', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers\MyProgram', '', ClassID);

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, 'MyProgram Context Menu Shell Extension');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('*\shellex\ContextMenuHandlers\MyProgram');
    DeleteRegKey('*\shellex\ContextMenuHandlers');
    DeleteRegKey('*\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'MyProgram Context Menu Shell Extension', ciMultiInstance,
    tmApartment);
end.

"Текст контекстного меню" (InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, 'Текст контекстного меню');) появляется только когда вызываю контекстное меню у одного файла, а если выделю несколько, то мой пункт меню пропадает. А мне надо получать пути к файлам всех выделенных в проводнике.

Всё перегуглил, нигде не нашёл как сделать для нескольких файлов :(

upd

С несколькими файлами разобрался. Если

Код


  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then

изменить на

Код


  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) > 0) then

, то пункт меню появляется и при выделении нескольких файлов, вот только как теперь занести в "FFileName" пути всех выделенных файлов?

Это сообщение отредактировал(а) GN1 - 2.2.2009, 20:31

GN1

Дата 2.2.2009, 21:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 23.4.2008
Где: Казахстан

Репутация: нет
Всего: нет

Сам разобрался smile

(справка помогла)

Код


var
  st: string;

...

var
  i, j: Int32;
begin
...
  st := '';
  j := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
  if j > 0 then
  begin
    for i := 0 to j -1 do
    begin
      DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
      Result := NOERROR;
      st := '"' + string(FFileName) + '" ' + st;
    end;
  end
  else
  begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
...
end;

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »