贴一篇文章，也许是你要的:
----------------------------------------------
①、 如 何 把 用 户 菜 单 项 加 入 系 统
菜 单， ②、 如 何 才 能 响 应 这 一 菜 单 项。
---- 要 解 决 第 一 个 问 题， 就 需 要 获 取 系 统 菜 单 的 句 柄， 这 一 点 可 用 API 函 数
getsystemmenu() 来 获 取（getmenu() 只 能 获 取 用 户 菜 单 句 柄）， 有 了 系 统 菜 单 句 柄， 便
可 以 用 API 函 数appendmenu() 向 系 统 菜 单 中 加 入 用 户 菜 单 选 项 了。
---- 要 解 决 第 二 个 问 题， 需 要 重 载 WM_SYSCOMMAND 或WM_MENUSELECT 消 息。 我 们
知 道， 当 用 户 从 菜 单 中 选 一 项 时， 系 统 便 会 发 出 WM_COMMMAND 消 息， 而 对
于 系 统 菜 单， 则 会 发 出 WM_SYSCOMMAND 消 息， 重 载 这 个 消 息， 并 判 断 选 中 菜
单 的 ID 值 是 否 为 用 户 设 定 值 便 可 以 了。Delphi 为 我 们 提 供 了 这 方 面 的 机 制， 使
我 们 能 方 便 的 实 现 这 一 功 能。 当 然， 为 实 现 这 一 功 能 我 们 还 可 以 利 用 子 类
或 为 系 统 加 消 息 钩 子 的 方 法 来 解 决。
---- 为 了 便 于 实 现， 在 这 里， 我 们 采 用 重 载 WM_SYSCOMMAND 消 息 和 填 写
WM_MENUSELECT 消 息 结 构 的 方 法 来 实 现 这 一 功 能。
---- 下 面 为 笔 者 为 实 现 这 一 功 能 而 开 发 的 实 例。
---- 程 序 在Delphi ver 1.0 下 调 试 通 过。
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.
////////////////////////////////////////////////////
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
SC_MyMenuItem = WM_USER + 1;
procedure TForm1.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, '');
AppendMenu(GetSystemMenu(Handle, FALSE),
MF_STRING,
SC_MyMenuItem,
'My Menu Item');
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MyMenuItem then
ShowMessage('Got the message') else
inherited;
end;
////////////////////////////////////////////////////////
这个过程可以：
procedure AppendToSystemMenu (Form: TForm;
Item: string; ItemID: Word);
{----------------------------------------------------------------}
{ Appends menu item to end of system menu of specified form and }
{ to system menu of application's minimized icon. To append a }
{ separator bar start the item with '-' (and use 0 for ItemID). }
{----------------------------------------------------------------}
var
NormalSysMenu, MinimizedMenu: HMenu;
AItem: array[0..255] of Char;
PItem: PChar;
begin
NormalSysMenu := GetSystemMenu(Form.Handle, false);
MinimizedMenu := GetSystemMenu(Application.Handle, false);
if StartsWith('-', Item) then
AppendMenu(NormalSysMenu, MF_SEPARATOR, 0, nil);
AppendMenu(MinimizedMenu, MF_SEPARATOR, 0, nil);
end
else
begin
PItem := StrPCopy(PChar(@AItem), Item);
AppendMenu(NormalSysMenu, MF_STRING, ItemID, PItem);
AppendMenu(MinimizedMenu, MF_STRING, ItemID, PItem);
end
end; {AppendToSystemMenu}
过程是如下定义：
function StartsWith (const StartString, theString: string)
: Boolean;
{-----------------------------------------------------------------}
{ Tests whether or not theString starts with the StartString. }
{ N.B. Case sensitive. }
{----------------------------------------------------------------}
begin
if Copy(theString, 1, length(StartString)) = StartString then
StartsWith := True
else
StartsWith := False
end; {StartsWith}
建立新FORM
type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure WinMsgHandler( var Msg : TMsg; var Handled : Boolean );
{ Public declarations }
end;
const
WM_ABOUT = WM_USER + 1; { About message }
IMPLEMENTATION
procedure TForm1.WinMsgHandler( var Msg : TMsg; var Handled : Boolean );
begin
If Msg.Message = WM_SYSCOMMAND then begin
if Msg.wParam = WM_ABOUT then Showmessage('Hello World!!');
end;
end;
你必须在窗体中加入以下方法：
Application.OnMessage := WinMsgHandler; {Use my message handler}
AppendMenu( GetSystemMenu( Self.Handle, False ),
MF_SEPARATOR, 0, ''); {Append our new value}
AppendMenu( GetSystemMenu(
rm1.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, False), { API call; see API Help }
MF_STRING, SC_UDF, '&About');
AppendMenu(GetSystemMenu(Application.Handle, False),
MF_STRING, SC_UDF, '&About');
Application.OnMessage := AppOnMessage;
end;
procedure TForm1.AppOnMessage(VAR Msg: TMsg; VAR Handled: BOolean);
VAR
Hf, Ha : hMenu;
Checkd : Boolean;
CONST
NuFlag : ARRAY[Boolean] OF Word = (MF_CHECKED, MF_UNCHECKED);
NuHWnd : ARRAY[Boolean] OF HWnd = (HWND_TOPMOST, HWND_NOTOPMOST);
BEGIN
IF Msg.Message WM_SYSCOMMAND THEN Exit;
IF Msg.wParam AND $FFF0 SC_UDF THEN Exit;
{ show your About Dialog }
END;
end.
