您现在的位置:首页 >> VCL >> VCL >> 内容

Delphi中检测TPopupMenu的关闭(弹出下拉)事件

时间:2011/9/3 16:24:27 点击:

  核心提示:600) this.width = 600;'>unit PopupListEx;interfaceuses Controls;const CM_MENU_CLOSED = CM_BASE + 100...

600) this.width = 600;">

unit PopupListEx;

interface

uses Controls;

const
   CM_MENU_CLOSED = CM_BASE + 1001;
   CM_ENTER_MENU_LOOP = CM_BASE + 1002;
   CM_EXIT_MENU_LOOP = CM_BASE + 1003;

implementation

uses Messages, Forms, Menus;

type
   TPopupListEx = class(TPopupList)
   protected
     procedure WndProc(var Message: TMessage) ; override;
   private
     procedure PerformMessage(cm_msg : integer; msg : TMessage) ;
   end;

{ TPopupListEx }
procedure TPopupListEx.PerformMessage(cm_msg: integer; msg : TMessage) ;
begin
   if Screen.Activeform <> nil then
     Screen.ActiveForm.Perform(cm_msg, msg.WParam, msg.LParam) ;
end;

procedure TPopupListEx.WndProc(var Message: TMessage) ;
begin
   case message.Msg of
     WM_ENTERMENULOOP: PerformMessage(CM_ENTER_MENU_LOOP, Message) ;
     WM_EXITMENULOOP : PerformMessage(CM_EXIT_MENU_LOOP, Message) ;
     WM_MENUSELECT :
     with TWMMenuSelect(Message) do
     begin
       if (Menu = 0) and (Menuflag = $FFFF) then
       begin
         PerformMessage(CM_MENU_CLOSED, Message) ;
       end;
     end;
   end;
   inherited;
end;

initialization
   Popuplist.Free; //free the "default", "old" list
   PopupList:= TPopupListEx.Create; //create the new one
   // The new PopupList will be freed by
   // finalization section of Menus unit.
end.

 

uses PopupListEx, ...

TForm1 = class(TForm)
...
private
   procedure CM_MenuClosed(var msg: TMessage) ; message CM_MENU_CLOSED;
   procedure CM_EnterMenuLoop(var msg: TMessage) ; message CM_ENTER_MENU_LOOP;
   procedure CM_ExitMenuLoop(var msg: TMessage) ; message CM_EXIT_MENU_LOOP;
...
implementation

procedure TForm1.CM_EnterMenuLoop(var msg: TMessage) ;
begin
   Caption := 'PopMenu entered';
end;

procedure TForm1.CM_ExitMenuLoop(var msg: TMessage) ;
begin
   Caption := 'PopMenu exited';
end;

procedure TForm1.CM_MenuClosed(var msg: TMessage) ;
begin
   Caption := 'PopMenu closed';
end;



迅雷专用高速下载

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2020 版权所有 All Rights Reserved.
  • 沪ICP备05001939号