Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.01.2012, 09:43   #1
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
Вопрос Контекстное меню (IContextMenu)

Подскажите как вставить в контекстное меню определенную иконку?

Привожу исходный код DLL-ки

Код:
unit Unit1;

interface
{$R vista_admin_new.RES}

uses
  Windows, Forms, StdCtrls, ShellApi, SysUtils, Classes, Controls,
  ComServ, ComObj, ShlObj, ActiveX, Dialogs, TlHelp32;

const
  CLSID_ContextMenu: TGUID = '{AB69D961-B907-11D0-B8FA-A85800C10000}';

type
  TFormViewContextMenu = class(TComObject,
      IShellExtInit, IContextMenu)
  private
    FFileName: string;
  public

    function IShellExtInit.Initialize = ShellInit;
    function ShellInit(Folder: PItemIDList;
      DataObject: IDataObject;
      ProgID: HKEY): HResult; stdcall;

    function QueryContextMenu(Menu: HMENU;
      Index, CmdFirst, CmdLast,
      Flags: UINT): HResult; stdcall;
    function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;
    function InvokeCommand(var CommandInfo: TCMInvokeCommandInfo):
      HResult; stdcall;
  end;

implementation

uses
  Registry;

function TFormViewContextMenu.ShellInit(Folder: PItemIDList;
  DataObject: IDataObject;
  ProgID: HKEY): HResult;
var
  Medium: TStgMedium;
  FE: TFormatEtc;
begin
  if DataObject = nil then
  begin
    Result := E_FAIL;
    Exit;
  end;

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

  Result := DataObject.GetData(FE, Medium);
  if Failed(Result) then
    Exit;
  try
    if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
    begin
      SetLength(FFileName, MAX_PATH);
      DragQueryFile(Medium.hGlobal, 0, PChar(FFileName), MAX_PATH);
      Result := NOERROR;
    end
    else
      Result := E_FAIL;
  finally
    ReleaseStgMedium(Medium);
  end;
end;

function TFormViewContextMenu.QueryContextMenu(Menu: HMENU;
  Index, CmdFirst, CmdLast, Flags: UINT): HResult;
begin
  Result := 0;
  if ((Flags and $0000000F) = CMF_NORMAL) or
    ((Flags and CMF_EXPLORE) <> 0) or ((Flags and CMF_VERBSONLY) <> 0) then
  begin
    InsertMenu(Menu, 0, MF_SEPARATOR or MF_BYPOSITION, CmdFirst, nil);
    InsertMenu(Menu, 1, MF_STRING or MF_BYPOSITION, CmdFirst, PChar('Пункт Меню №1'));
    InsertMenu(Menu, 2, MF_STRING or MF_BYPOSITION, CmdFirst + 1, PChar('Другой Пункт Меню'));
    Result := 3; // сколько добавили пунктов
  end;
end;

function TFormViewContextMenu.GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult;
begin
  case idCmd of
    0:
      begin
        if uFlags = GCS_HELPTEXT then
        begin
          StrCopy(pszName, '');
        end;
        Result := NOERROR;
      end;
  else
    Result := E_INVALIDARG;
  end;
end;

function TFormViewContextMenu.InvokeCommand(var CommandInfo:
  TCMInvokeCommandInfo): HResult;
begin
  if HiWord(Integer(CommandInfo.lpVerb)) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;
  case LoWord(CommandInfo.lpVerb) of
    0:
      begin
       // FFileName - Файл на котором кликаем в проводнике
        ShowMessage('Пункт Меню №1' + #13#10);
      end;
    1:
      begin
        ShowMessage('Другой Пункт Меню' + #13#10);
      end;
  else
    Result := E_INVALIDARG;
  end;
end;

initialization
  TComObjectFactory.Create(ComServer, TFormViewContextMenu, CLSID_ContextMenu, '', '', ciMultiInstance);
end.
Алексей_C вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Контекстное меню AlexeiDelejov Общие вопросы Delphi 2 13.09.2011 09:50
Контекстное меню Miller-1981 Win Api 0 05.12.2010 01:35
контекстное меню J.Bond Помощь студентам 3 17.06.2010 21:18
Контекстное меню anGeee Общие вопросы Delphi 1 30.10.2009 21:28
Контекстное меню mar4elo Общие вопросы Delphi 19 18.09.2009 14:30