在任意程序的任意菜单里面添加自己的菜单项
下面的代码就可以在系统当前桌面运行的任何程序内的任意菜单内添加一个菜单项(OwnerDraw的例外):Test
/// Copyright by Kingron,Zswang
/// 感谢Zswang补充完整了命令处理部分~~~~~~:)
http://www.eping.net/fourm/dispbbs.asp?boardID=22&replyID=5570&ID=605&skin=1
library Project2;
uses
SysUtils,
Windows,
Classes,
Messages;
{$R *.res}
var
hNextHook: HWND;
iItemIndex: Integer = -1;
hMenuList: array of HMENU;
iMenuCount: Integer = 0;
const
cMeunIdent = $0001;
function MenuItemIndex(hMenu: HMENU; uItem: UINT): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to GetMenuItemCount(hMenu) - 1 do
if GetMenuItemID(hMenu, I) = uItem then
begin
Result := I;
Break;
end;
end; { MenuItemIndex }
procedure ShowMsg(Msg: string);
begin
MessageBox(GetActiveWindow, Pchar(Msg), 'Info', MB_OK + MB_ICONINFORMATION);
end;
function CallWndProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
const
MENU_ID = 65530;
var
Msg: PCWPStruct;
mInfo: MENUITEMINFO;
begin
{
Msg := pointer(lParam);
case Msg.message of
WM_INITMENUPOPUP:
begin
with mInfo do
begin
cbSize := SizeOf(mInfo);
fMask :=MIIM_TYPE or MIIM_ID;
fType := MFT_STRING;
fState := MFS_DEFAULT;
wID := MENU_ID;
hSubMenu := 0;
hbmpChecked := 0;
dwItemData := 0;
dwTypeData := '_Test_';
cch :=4;
hbmpItem :=0;
end;
InsertMenuItem(Msg.wParam, 1, True, mInfo);
// ShowMsg(SysErrorMessage(GetLastError));
end;
WM_COMMAND:
begin
if Msg.wParam = MENU_ID then
ShowMsg('OK');
// Beep(500, 100);
end;
WM_MENUCOMMAND, WM_SYSCOMMAND:
begin
if Msg.wParam = MENU_ID then
ShowMsg('OK');
// Beep(500, 100);
end;
end;
}
with PCWPStruct(lParam)^ do
case message of
WM_INITMENUPOPUP:
begin
iItemIndex := MenuItemIndex(wParam, cMeunIdent);
if iItemIndex < 0 then
begin
InsertMenu(wParam, 0, MF_BYCOMMAND or MF_STRING, cMeunIdent, 'Test');
iItemIndex := MenuItemIndex(wParam, cMeunIdent);
///////Begin 记录修改的菜单
Inc(iMenuCount);
SetLength(hMenuList, iMenuCount);
hMenuList[iMenuCount - 1] := wParam;
///////End 记录修改的菜单
end;
end;
$1ED { Mouse down of Menu}: ;
$1EF { Mouse up of Menu }: if wParam = iItemIndex then
begin
ShowMsg('OK');
// Beep(500, 100);
end;
end;
Result := CallNextHookEx(hNextHook, nCode, wParam, lParam);
end;
procedure Hook; stdcall;
begin
hNextHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, 0);
end;
procedure UnHook; stdcall;
begin
if hNextHook <> 0 then
UnhookWindowsHookEx(hNextHook);
end;
exports
Hook, UnHook;
begin
hNextHook := 0;
end.
//////////////
调用代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure Hook; stdcall;external 'project2.dll';
procedure UnHook; stdcall;external 'project2.dll';
procedure TForm1.FormCreate(Sender: TObject);
begin
Hook;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHook;
end;
end.