tiviewimpl.pas

delphi com深入编程,非常有收藏价值

unit TIViewImpl;

interface

uses
  Windows, ActiveX, ComObj, ShlObj;

type
  TTIDemoContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFileName: string;
    FViewMenuItem: UINT;

    function IShellExtInit.Initialize = InitShellExtension;
  protected
    {Declare IShellExtInit methods here}
    function InitShellExtension(pidlFolder: PItemIDList;
      lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;

    {Declare IContextMenu methods here}
    function QueryContextMenu(Menu: HMENU;
      indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  end;

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

const
  Class_TIDemoContextMenu: TGUID = '{66DA0B20-098C-11D3-B3DC-0040F67455FE}';

implementation

uses ComServ, ShellAPI, SysUtils;

function TTIDemoContextMenu.GetCommandString(idCmd, uType: UINT;
  pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
  Result := S_OK;

  if (idCmd = FViewMenuItem) and
     ((uType and GCS_HELPTEXT) <> 0) then
    StrLCopy(pszName, 'View selected type library', cchMax)
  else
    Result := E_INVALIDARG;
end;

function TTIDemoContextMenu.InitShellExtension(pidlFolder: PItemIDList; lpdobj: IDataObject;
      hKeyProgID: HKEY): HResult; stdcall;
var
  Medium: TStgMedium;
  Format: TFormatEtc;
begin
  // Fail if no data object was provided
  if lpdobj = nil then begin
    Result := E_FAIL;
    exit;
  end;

  // Set up the TFormatEtc structure...
  with Format do begin
    cfFormat := CF_HDROP;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lIndex := -1;
    tymed := TYMED_HGLOBAL;
  end;

  // Fail if we can't get to the data
  Result := lpdobj.GetData(Format, Medium);
  if Failed(Result) then
    exit;

  try
    // Make sure the user only selected one file
    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 TTIDemoContextMenu.InvokeCommand(
  var lpici: TCMInvokeCommandInfo): HResult;
var
  MI: Integer;
begin
  Result := S_OK;

  MI := Integer(lpici.lpVerb);

  if HiWord(MI) <> 0 then begin
    // We were called by another application
    // not supported in this example.
    Result := E_FAIL;
    exit;
  end;

  if LoWord(MI) = FViewMenuItem then
    // Execute TIDemo
    ShellExecute(0, nil, 'TIDemo.exe', PChar(FFileName), nil, SW_SHOW)
  else
    Result := E_INVALIDARG;
end;

function TTIDemoContextMenu.QueryContextMenu(Menu: HMENU; indexMenu,
  idCmdFirst, idCmdLast, uFlags: UINT): HResult;
begin
  Result := NOERROR;

  FViewMenuItem := indexMenu;

  if (uFlags and $000F) = CMF_NORMAL then begin
    InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'View TypeLib...');
    Result := 1;
  end else if (uFlags and CMF_EXPLORE) <> 0 then begin
    InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'View TypeLib from Explorer...');
    Result := 1;
  end else if (uFlags and CMF_VERBSONLY) <> 0 then begin
    InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'View TypeLib from Shortcut...');
    Result := 1;
  end;
end;

{ TTIDemoFactory }

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

  if Register then begin
    CreateRegKey('.tlb', '', 'TypeLibrary');
    CreateRegKey('TypeLibrary\shellex\ContextMenuHandlers\' +
      ClassName, '', GUIDToString(ClassID));
  end else begin
    DeleteRegKey('.tlb');
    DeleteRegKey('TypeLibrary\shellex\ContextMenuHandlers\' +
      ClassName);
  end;
end;

initialization
{$IFDEF VER100}
  TTIDemoFactory.Create(ComServer, TTIDemoContextMenu, Class_TIDemoContextMenu,
    'TIDemoContextMenu', '', ciMultiInstance);
{$ELSE}
  TTIDemoFactory.Create(ComServer, TTIDemoContextMenu, Class_TIDemoContextMenu,
    'TIDemoContextMenu', '', ciMultiInstance, tmApartment);
{$ENDIF}
end.