首页  编辑  

系统菜单的复制

Tags: /超级猛料/VCL/Form,窗体/标题栏和边框/   Date Created:

很多程序都有模拟一个假的标题栏的功能, 当时大部分的程序没有处理标题栏的"弹出菜单",如何在模拟的标题栏上面右击的时候也能弹出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);

        //如果是横线e

     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);

---------------------------------------

下面的方法也算比较简单的:

procedure TForm1.Button1Click(Sender: TObject);

var

 hMenuHandle: hMENU;

 hMenuItem: DWORD;

 p: TPoint;

begin

 {recalculate button coordinates to screen coordinates}

 p.X := Button1.Left;

 p.Y := Button1.Top;

 p   := Button1.ClientToScreen(p);

 hMenuHandle := GetSystemMenu(Handle, False);

 hMenuItem   := Longword(Windows.TrackPopupMenu(hMenuHandle,

   TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, p.X, p.Y, 0, Handle, nil));

 if hMenuItem > 0 then

   SendMessage(Handle, WM_SYSCOMMAND, hMenuItem, 0);

end;