在windows(ms word)程序中加入自己的命令按钮或者在右键菜单中加入自己的命令。

Question

program Psysmenu;
uses
  Forms,
  Sysmenu in '\SYSMENU.PAS' {Form1};{$R *.RES}
begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.unit Sysmenu;interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, 
  Graphics, Controls,Forms, Dialogs;
type
  TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
  private
      procedure  user_sysmenu(var msg:twmmenuselect);
                               message wm_syscommand;  public
        { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}procedure  TForm1.user_sysmenu(var msg:TWMMENUSELECT);
begin
   if msg.iditem=100 then
      showmessage('     响应系统菜单!')
      { 也 可 以setwindowpos()来实现处于最前端功能}
   else
      inherited;     { 作缺省处理,必须调用这一过程}
end;procedure TForm1.FormCreate(Sender: TObject);
   var hmenu:integer;
begin
   hmenu:=getsystemmenu(handle,false);
   {获取系统菜单句柄}
   appendmenu(hmenu,MF_SEPARATOR,0,nil);
   appendmenu(hmenu,MF_STRING,100,'加入系统菜单');
   {加入用户菜单}
end;
end.

Answer 1

编写Context Menu Handler必须实现IShellExtInit、IContextMenu和TComObjectFactory三个接口。IShellExtInit实现
接口的初始化，IContextMenu接口对象实现上下文相关菜单，IComObjectFactory接口实现对象的创建。
    下面来介绍具体的程序实现。首先在Delphi中点击菜单的 File|New 项，在New Item窗口中选择DLL建立一个DLL工程文件。
然后点击菜单的 File|New 项，在New Item窗口中选择Unit建立一个Unit文件，点击点击菜单的 File|New 项，在New Item窗口
中选择Form建立一个新的窗口。将将工程文件保存为Contextmenu.dpr ，将Unit1保存为Contextmenuhandle.pas，将Form保存为
OpWindow.pas。
Contextmenu.dpr的程序清单如下：
library contextmenu;
    uses
  ComServ,
  contextmenuhandle in 'contextmenuhandle.pas',
  opwindow in 'opwindow.pas' {Form2};exports
   DllGetClassObject,
   DllCanUnloadNow,
   DllRegisterServer,
   DllUnregisterServer;{$R *.TLB}{$R *.RES}beginend.    Contextmenuhandle的程序清单如下：
unit ContextMenuHandle;interface
   uses Windows,ActiveX,ComObj,ShlObj,Classes;type
   TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
   private
      FFileName: array[0..MAX_PATH] of Char;
   protected
      function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
      function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
               hKeyProgID: HKEY): HResult; stdcall;
      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 = '{19741013-C829-11D1-8233-0020AF3E97A0}';{全局唯一标识符(GUID)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}
var
   FileList:TStringList;
implementationuses ComServ, SysUtils, ShellApi, Registry,UnitForm;function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
   hKeyProgID: HKEY): HResult;
var
   StgMedium: TStgMedium;
   FormatEtc: TFormatEtc;
   FileNumber,i:Integer;
begin
   file://如/果lpdobj等于Nil，则本调用失败
   if (lpdobj = nil) then begin
      Result := E_INVALIDARG;
      Exit;
   end;   file://首/先初始化并清空FileList以添加文件
   FileList:=TStringList.Create;
   FileList.Clear;
   file://初/始化剪贴版格式文件
   with FormatEtc do begin
      cfFormat := CF_HDROP;
      ptd := nil;
      dwAspect := DVASPECT_CONTENT;
      lindex := -1;
      tymed := TYMED_HGLOBAL;
   end;
   Result := lpdobj.GetData(FormatEtc, StgMedium);   if Failed(Result) then Exit;   file://首/先查询用户选中的文件的个数
   FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
   file://循/环读取，将所有用户选中的文件保存到FileList中
   for i:=0 to FileNumber-1 do begin
      DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
      FileList.Add(FFileName);
      Result := NOERROR;
   end;   ReleaseStgMedium(StgMedium);
end;function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
   idCmdLast, uFlags: UINT): HResult;
begin
  Result := 0;
  if ((uFlags and $0000000F) = CMF_NORMAL) or
     ((uFlags and CMF_EXPLORE) <> 0) then begin
    // 往Context Menu中加入一个菜单项 ,菜单项的标题为察看位图文件
    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
        PChar('文件操作'));
    // 返回增加菜单项的个数
    Result := 1;
  end;
end;function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  frmOP:TForm1;
begin
  // 首先确定该过程是被系统而不是被一个程序所调用
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then
  begin
     Result := E_FAIL;
     Exit;
  end;
  // 确定传递的参数的有效性
  if (LoWord(lpici.lpVerb) <> 0) then begin
     Result := E_INVALIDARG;
     Exit;
  end;   file://建/立文件操作窗口
  frmOP:=TForm1.Create(nil);
  file://将/所有的文件列表添加到文件操作窗口的列表中
  frmOP.ListBox1.Items := FileList;
  Result := NOERROR;
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
      {返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
      移动到该菜单项时出现在状态条上。}
      StrCopy(pszName, PChar('点击该菜单项将执行文件操作'));
      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);
      file://当/注册扩展库文件时，添加库到注册表中
      CreateRegKey('*\shellex', '', '');
      CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
      CreateRegKey('*\shellex\ContextMenuHandlers\FileOpreation', '', ClassID);    file://如/果操作系统为Windows NT的话
      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, 'Context Menu Shell Extension');
      finally
         Free;
      end;
   end
   else begin
      DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
      inherited UpdateRegistry(Register);
   end;
end; initialization
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
   '', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);end.
    在OpWindow窗口中加入一个TListBox控件和两个TButton控件，OpWindows.pas的程序清单如下：
unit opwindow;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    FileList:TStringList;
    { Public declarations }
  end;var
   Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
begin
  FileList:=TStringList.Create;
  Button1.Caption :='复制文件';
  Button2.Caption :='移动文件';
  Self.Show;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FileList.Free;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  sPath:string;
  fsTemp:SHFILEOPSTRUCT;
  i:integer;
begin
  sPath:=InputBox('文件操作','输入复制路径','c:\windows');
  if sPath<>''then begin
    fsTemp.Wnd := Self.Handle;
    file://设/置文件操作类型
    fsTemp.wFunc :=FO_COPY;
    file://允/许执行撤消操作
    fsTemp.fFlags :=FOF_ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count-1 do begin
      file://源/文件全路径名
      fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
      file://要/复制到的路径
      fsTemp.pTo := PChar(sPath);
      fsTemp.lpszProgressTitle:='拷贝文件';
      if SHFileOperation(fsTemp)<>0 then
        ShowMessage('文件复制失败');
    end;
  end;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  sPath:string;
  fsTemp:SHFILEOPSTRUCT;
  i:integer;
begin
  sPath:=InputBox('文件操作','输入移动路径','c:\windows');
  if sPath<>''then begin
    fsTemp.Wnd := Self.Handle;
    fsTemp.wFunc :=FO_MOVE;
    fsTemp.fFlags :=FOF_ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count-1 do begin