Форум программистов [Powered by Invision Power Board]

Код


unit MyMenus;

interface
uses Menus;

var OnMenuMouseMsg:procedure (Msg:cardinal;Item:TMenuItem;out Hide:boolean)=nil;

implementation
uses messages,windows,SysUtils;

type TMyPopupList=class(TPopupList)
                  private
                   FLastMenuItem:TMenuItem;
                   procedure Hook;
                   procedure Unhook;
                   function AllowHideMenu(msg:DWORD;Item:TMenuItem):boolean;
                  public
                   constructor Create(CreateFrom:TPopupList);
                   destructor Destroy;override;
                   procedure Assign(List:TPopupList);reintroduce;
                  protected
                   procedure WndProc(var Message:TMessage);override;
                  end;

var HHook:windows.HHOOK=0;

function TMyPopupList.AllowHideMenu(msg:DWORD;Item:TMenuItem):boolean;
begin
if (item=nil) or (@OnMenuMouseMsg=nil)
   then result:=true
   else OnMenuMouseMsg(msg,item,result);
end;

function FilterMenuMouseMsg(const msg:TMsg):integer;
begin
 if (msg.message>=WM_LBUTTONDOWN) and
    (msg.message<=WM_MBUTTONDBLCLK)
   then result:=SendMessage(PopupList.Window,msg.message,msg.wParam,msg.lParam)
   else result:=0;
end;

function HookProc(code:integer;wParam:WPARAM;var msg:TMSG):LRESULT;stdcall;
begin
result:=integer(code=MSGF_MENU);
if boolean(result) then result:=FilterMenuMouseMsg(msg);
if not boolean(result) then result:=CallNextHookEx(HHook,code,wParam,integer(@msg));
end;

procedure TMyPopupList.WndProc(var Message: TMessage);
var FindKind:TFindItemKind;i,Item:integer;info:TMenuInfo;
begin
case message.Msg of
 WM_EXITMENULOOP:FLastMenuItem:=nil;
 WM_LBUTTONDOWN..WM_MBUTTONDBLCLK:begin
                                  message.Result:=integer(not AllowHideMenu(message.msg,FLastMenuItem));
                                  if boolean(message.Result) then exit;
                                  end;
 WM_MENUSELECT:with TWMMenuSelect(Message) do//подглядел в menus.pas
                begin
                FindKind:=fkCommand;
                if MenuFlag and MF_POPUP<>0
                   then FindKind:=fkHandle;
                for i:=0 to Count-1 do
                    begin
                    if FindKind=fkHandle
                       then if Menu=0
                               then Item:=-1
                               else Item:=GetSubMenu(Menu,IDItem)
                       else Item:=IDItem;
                    FLastMenuItem:=TPopupMenu(Items[i]).FindItem(Item, FindKind);
                    end;
                end;
end;
inherited
end;

procedure TMyPopupList.Assign(List:TPopupList);
begin
inherited Assign(List);
FWindow:=List.Window;
end;

constructor TMyPopupList.Create(CreateFrom:TPopupList);
begin
inherited Create;
if assigned(CreateFrom)
   then begin
        Assign(CreateFrom);
        CreateFrom.Free
        end;
Hook;
end;

destructor TMyPopupList.Destroy;
begin
inherited;
Unhook
end;

procedure TMyPopupList.Hook;
begin
HHook:=SetWindowsHookEx(WH_MSGFILTER,@HookProc,0,GetCurrentThreadID);
end;

procedure TMyPopupList.Unhook;
begin
if HHook<>0 then begin
                 UnhookWindowsHookEx(HHook);
                 HHook:=0
                 end;
end;

initialization
PopupList:=TMyPopupList.Create(PopupList);

finalization

end.

Код


procedure MenuMsgHandler(Msg:cardinal;Item:TMenuItem;out Hide:boolean);
begin
hide:=(length(Item.Caption) mod 2) = 1 //тут твое решение
//а пока прячем при нажатии на пункты с нечетным числом букв :)
//или наоборот (в Item.Caption есть еще "&")
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
OnMenuMouseMsg:=MenuMsgHandler; //устанавливаешь свой обработчик
end;