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

Вниз

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

← →
APiC ©   (2007-01-27 05:50) [0]

как в кантекстное меню файла и папки добавить свой пункт и что бы при его выборе заускалась моя программ и в качестве параметра ей передовалось имя этого файла или папки. Заранее спасибо!

---

← →
Savek   (2007-01-27 10:15) [1]

Взято из DW5000 (сам не проверял)

Пример добавления пункта в контекстное меню Windows Explorer
------------------------------------------------------------------------------

// Откройте Delphi, выберите в меню New... Dynamic link library
// Скопируйте нижеприведенный текст DLL
// Скомпилируйте проект.
// Теперь нужно зарегистрировать полученную библиотеку.
// Наберите в командной строке regsvr32.exe sendtoweb.dll
// После этого откройте Windows Explorer и вы увидите новый
// пункт меню...

unit Sendtoweb;

// Author C Pringle Cjpsoftware.com

{ Реализация COM объекта расширения оболочки Windows Explorer. Этот
 COM объект способен перенаправлять запросы компоненту TPopupMenu. Компонент
 TPopupMenu должен находиться  на форме MenuComponentForm.
 Вы можете модернизировать код для большей гибкости.

 Компонент TContextMenu регистрируется как  глобальным обработчик
 контекстного меню. Это достигается модификацией ключа реестра
 HKEY_CLASSES_ROOT\*\ShellEx\ContextMenuHandlers.

 jfl
}

interface

uses

 Classes, ComServ, ComObj, ActiveX, Windows, ShlObj, Interfaces, Menus,
 ShellAPI, SysUtils, registry;

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

 TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
 private
   FFileName: string;
   function BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
     var IDCmdFirst: Integer): HMENU;
 protected
   szFile: array[0..MAX_PATH] of Char;
   // Необходимо для исключения предупреждения компилятора о неоднозначности
   function IShellExtInit.Initialize = IShellExtInit_Initialize;
 public
   { IShellExtInit }
   function IShellExtInit_Initialize(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;

var
 // Должен быть инициализирован перед регистрацией TContextMenu!
 GFileExtensions: TStringList;

const
 MenuCommandStrings: array[0..3] of string = (
   "", "&STW Web Upload", "&STW FTPClient", "&STW Setup"
   );

implementation

{ TContextMenuFactory }
{ Public }

function ReadDefaultPAth: string;
var
 path: string;
 Reg: TRegistry;
begin

 Reg := TRegistry.CReate;
 try
   with Reg do
   begin
     RootKey := HKEY_LOCAL_MACHINE;
     Path := "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths";

     if KeyExists(Path) then
     begin
       OpenKey(Path + "\sendtoweb.exe", false);
       Result := ReadString(#0);
       closekey;
     end;

     // Ключ добавлен в реестр.

   end;
 finally
   Reg.CloseKey;
   Reg.Free;
 end;

end; // Код регистрации

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
begin
 inherited UpdateRegistry(Register);

 // Регистрация нашего обработчика
 if Register then
 begin
   CreateRegKey("*\ShellEx\ContextMenuHandlers\SendToWeb", "",
     GUIDToString(Class_ContextMenu));
   CreateRegKey("CLSID\" + GUIDToString(ClassID) + "\" +
     ComServer.ServerKey, "ThreadingModel", "Apartment");
 end
 else
 begin
   DeleteRegKey("*\ShellEx\ContextMenuHandlers\SendToWeb");
 end;
end;

{ TContextMenu }
{ Private }

{ Построение контекстного меню с использованием хэндла существующего меню.
 Если Menu =  nil, мы создаем новый хэндл меню и возвращаем его как результат
 функции. Заметьте, что обработчик не поддерживаетвложенные (рекурсивные)
 меню. }



---

← →
Savek   (2007-01-27 10:16) [2]

продолжение ...

function TContextMenu.BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
 var IDCmdFirst: Integer): HMENU;
var
 i: Integer;
 menuItemInfo: TMenuItemInfo;
begin
 if Menu = 0 then
   Result := CreateMenu
 else
   Result := Menu;

 // Подготавливаем меню
 with menuitemInfo do
 begin
   cbSize := SizeOf(TMenuItemInfo);
   fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
     MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE or MIIM_CHECKMARKS;
   fType := MFT_STRING;
   fState := MFS_ENABLED;
   hSubMenu := 0;
   hbmpChecked := 0;
   hbmpUnchecked := 0;
 end;

 for i := 0 to High(MenuCommandStrings) do
 begin
   if i = 0 then
     menuitemInfo.fType := MFT_SEPARATOR
   else
     menuiteminfo.ftype := MFT_String;
   if i = 1 then
     menuitemInfo.fstate := MFS_ENABLED or MFS_DEFAULT
   else
     menuitemInfo.fstate := MFS_ENABLED;

   menuitemInfo.dwTypeData := PChar(MenuCommandStrings[i]);
   menuitemInfo.wID := IDCmdFirst;
   InsertMenuItem(Result, IndexMenu + i, True, menuItemInfo);
   Inc(IDCmdFirst);
 end;
end;

{ IShellExtInit }

function TContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList;
 lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
 medium: TStgMedium;
 fe: TFormatEtc;

begin
 with fe do
 begin
   cfFormat := CF_HDROP;
   ptd := nil;
   dwAspect := DVASPECT_CONTENT;
   lindex := -1;
   tymed := TYMED_HGLOBAL;
 end;
 // Ошибка, если  lpdobj = Nil.
 if lpdobj = nil then
 begin
   Result := E_FAIL;
   Exit;
 end;
 Result := lpdobj.GetData(fe, medium);
 if Failed(Result) then
   Exit;
 // Если выбран только один файл, получаем его имя и сохраняем в
 // szFile. иначе - ошибка.
 if DragQueryFile(medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
 begin
   DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
   Result := NOERROR;
 end
 else
   Result := E_FAIL;
 ReleaseStgMedium(medium);
end;

{ IContextMenu }

function TContextMenu.QueryContextMenu(Menu: HMENU;
 indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
 extension: string;
 I: Integer;
 idLastCommand: Integer;
begin
 Result := E_FAIL;
 idLastCommand := idCmdFirst;

 // Получаем расширение файла и определяем, есть ли для него
 // зарегистрированный обработчик
//  extension := UpperCase( ( FFileName ) );

//for i := 0 to GFileExtensions.Count - 1 do
//   if Pos(Lowercase(GFileExtensions[ i ]),lowercase(extension))=0 then
 //  begin
 BuildSubMenu(Menu, indexMenu, idLastCommand);
 // Return value is number of items added to context menu
 Result := idLastCommand - idCmdFirst;
 //      Exit;
 //    end;
end;

function TContextMenu.InvokeCommand(var lpici:
 TCMInvokeCommandInfo): HResult;
var
 idCmd: UINT;
begin
 if HIWORD(Integer(lpici.lpVerb)) <> 0 then
   Result := E_FAIL
 else
 begin
   idCmd := LOWORD(lpici.lpVerb);
   Result := S_OK;

   // Активизация диалога и подготовка к послке данных в Web

   case idCmd of
     1:
       begin

         ShellExecute(GetDesktopWindow, nil,
           Pchar(ExtractFileName(ReadDefaultPath)),
           Pchar("Direct" + """ + szfile + """), nil, SW_SHOW);

       end;
     3:
       begin
         ShellExecute(GetDesktopWindow, nil,
           Pchar(ExtractFileName(ReadDefaultPath)),
           Pchar("Path"), nil, SW_SHOW);

       end;
     2:
       ShellExecute(GetDesktopWindow, nil,
         Pchar(ExtractFileName(ReadDefaultPath)),
         PChar(""), nil, SW_SHOW);
   else
     Result := E_FAIL;
   end;
 end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT;
 pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;

begin
 //  StrCopy( pszName, "Send To The Web") ;

 Result := S_OK;
end;

initialization
 { Заметьте, что в данном фрагменте мы создаем экземпляр TContextMenuFactory,
 а не TComObjectFactory. }
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
   "ContextMenu", "Send To The Web", ciMultiInstance);

 // Инициализируем список расширений
 GFileExtensions := TStringList.Create;
 // GFileExtensions.Add( "setup msn" );

finalization
 GFileExtensions.Free;
end.




---

← →
КиТаЯц ©   (2007-01-27 10:18) [3]

Жмакни на файле, в меню выбери "открыть с помощью" - обзор - MyProgram, не ставь "использовать для всех файлов".
После попытки, или таки, открытия файла меню "открыть с помощью" появится субменю в котором твоя программа будет в списке приложений уже пытавшихся открывать файлы этого типа. Работает на WinXP.
Чтобы просто (не субменю) пункт добавить "Открыть в MyProg", а так же для папок - там что-то в реестре писать надо, не помню. Поищи какой-нибудь FAQ по Windows. Сто раз встречал пример как добавить пункт "Открыть в командной строке"...

---

← →
КиТаЯц ©   (2007-01-27 10:19) [4]

> Savek   (27.01.07 10:15) [1]

Опередил... :)
А зачем такие сложности, если просто надо в реестре пару строк прописать?

---

← →
КиТаЯц ©   (2007-01-27 10:33) [5]

Вот нашел для папок:

В контекстное меню папок можно добавить команду "Сеанс MS-DOS", которая
будет вызывать окно MS-DOS в текущей папке. Для этого нужно создать файл с
расширением .REG, содержащий следующие данные:
==========
REGEDIT4
[HKEY_CLASSES_ROOT\Folder\Shell\DosPrompt]
@="&Сеанс MS-DOS" ;Здесь указано название команды
[HKEY_CLASSES_ROOT\Folder\Shell\DosPrompt\Command]
@="C:\\Windows\\Command.com /k cd %1" ;Здесь указана сама команда


---

← →
TRUNK ©   (2007-01-27 23:43) [6]

> там что-то в реестре писать надо

На примере Winamp (в формате Windows Registry Editor):

[HKEY_CLASSES_ROOT\.mp3]
@="Winamp.File"

[HKEY_CLASSES_ROOT\Winamp.File]
@="Winamp media file"

[HKEY_CLASSES_ROOT\Winamp.File\DefaultIcon]
@="E:\\Program Files\\Winamp\\winamp.exe,4"

[HKEY_CLASSES_ROOT\Winamp.File\shell]
@="Play"                                                   <-- команда по умолчанию

[HKEY_CLASSES_ROOT\Winamp.File\shell\Play]
@="Воспроизвести в Winamp"е"

[HKEY_CLASSES_ROOT\Winamp.File\shell\Play\command]
@="\"E:\\Program Files\\Winamp\\winamp.exe\" \"%1\""

---

← →
apic ©   (2007-02-01 07:18) [7]

Спасибо мужики, ВЫ просто монстры программирования!

---

← →
te   (2007-02-01 18:27) [8]

fdf

---

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

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

Наверх

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