系统菜单的复制

字体大小: 中小 标准 ->行高大小: 标准
很多程序都有模拟一个假的标题栏的功能, 当时大部分的程序没有处理标题栏的“弹出菜单”,如何在模拟的标题栏上面右击的时候也能弹出SYS Menu呢?

有两个方法,一个是处理鼠标消息,不过不知道应该处理那个消息,另外一个就是模拟一个一样的菜单,下面的代码可以做到这一点:

procedure TForm1.Button3Click(Sender: TObject);

var

item: TMenuItem;

sysmenuHandle: HMENU;

i, itemcount: Integer;

buffer: array[0..128] of Char;

itemID: Integer;

itemflags: DWORD;

begin

handleNeeded;

//得到系统菜单的handle

sysmenuHandle := GetSystemMenu(handle, false);

if sysmenuHandle <> 0 then

begin

//得到系统菜单的个数

itemcount := GetMenuItemcount(sysmenuHandle);

for i := 0 to itemcount - 1 do

begin

//得到指定菜单项的当前状态

itemflags := GetMenuState(sysmenuhandle, i, MF_BYPOSITION);

//如果是横线

if (itemflags and MF_SEPARATOR) = MF_SEPARATOR then

item := NewLine

else begin

//得到指定菜单项的Caption

GetMenuString(sysmenuhandle, i, buffer, sizeof(buffer), MF_BYPOSITION);

//得到指定菜单的在系统菜单中的ID

itemID := GetMenuItemID(sysmenuhandle, i);

//创建新的MenuItem

item := NewItem(buffer, 0,

(itemflags and MF_CHECKED) = MF_CHECKED,

(itemflags and (MF_DISABLED or MF_GRAYED)) = 0,

SystemMenuClick,

0,

format('Sysmenu_%d', [itemid]));

item.tag := itemID;

end;

systemmenu.Add(item);

end;

end;

end;

procedure TForm1.SystemMenuClick(Sender: TObject);

begin

with Sender as TMenuitem do

Self.perform(WM_SYSCOMMAND, Tag, 0);

end;

***************************************

终于找到了:)

原来有一个消息,$313,就是弹出系统菜单的。M$没有公开。

procedure TForm1.Button1Click(Sender: TObject);

const

WM_POPUPSYSTEMMENU=$313;

begin

SendMessage(Handle, WM_POPUPSYSTEMMENU, 0, MakeLong(Mouse.CursorPos.X,Mouse.CursorPos.Y));

end;

P.S:如果需要无边框的bsNone风格,又需要弹出Menu的,那么请不要设置Form的BoderStyle为bsNone,并且不要设置BorderIcons的biSystemMenu为False。采用下面的代码设置边框风格:

SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and (not WS_CAPTION) or WS_DLGFRAME or WS_OVERLAPPED);

此文章由 http://www.ositren.com 收集整理 ,地址为: http://www.ositren.com/htmls/68403.html