对TrackPopupMenu不懂(100分)

DDK · 2001-11-09

我有一个小程序，把图标缩小到任务栏上后，点右键CreateMenu，再调用trackpopupMenu, 菜单是出来，可是我点到菜单以外的地方，菜单并不消失。

Adnil · 2001-11-09

给你一段代码你可以看看 unit ADTrayIcon; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,   Menus, ShellApi, ExtCtrls; const   { Define user-defined message sent by the trayicon. We avoid low user-defined     messages that are used by Windows itself (eg. WM_USER+1 = DM_SETDEFID). }   WM_TRAYNOTIFY = WM_USER + 1024;   // Constant used for recreating trayicon on system traybar recover   IconID = 1;   // Constants used for balloon hint feature   WM_RESETTOOLTIP = WM_USER + 1025;   NIIF_NONE    = $00000000;   NIIF_INFO    = $00000001;   NIIF_WARNING = $00000002;   NIIF_ERROR   = $00000003;   NIF_INFO     = $00000010; var   WM_TASKBARCREATED: Cardinal; type   { You can use the TNotifyIconData record structure defined in shellapi.pas.     However, WinME, Win2000, and WinXP have expanded this structure. We define     a similar structure, TNotifyIconDataEx. }   TNotifyIconDataEx = record     cbSize: DWORD;     Wnd: HWND;     uID: UINT;     uFlags: UINT;     uCallbackMessage: UINT;     hIcon: HICON; //    szTip: array[0..63] of AnsiChar;     szTip: array[0..127] of AnsiChar;     dwState: DWORD;     dwStateMask: DWORD;     szInfo: array[0..255] of AnsiChar;     uTimeout: UINT; // union with uVersion: UINT;     szInfoTitle: array[0..63] of AnsiChar;     dwInfoFlags: DWORD;   end;   TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);   TBalloonHintTimeOut = 10..60;   // Windows defines 10-60 secs. as min-max   TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;   TADTrayIcon = class(TComponent)   private     FEnabled: Boolean;     FIcon: TIcon;     FIconVisible: Boolean;     FHint: String;     FPopupMenu: TPopupMenu;     FLeftPopup: Boolean;     FOnClick,     FOnDblClick: TNotifyEvent;     FOnCycle: TCycleEvent;     FOnMouseDown,     FOnMouseUp: TMouseEvent;     FOnMouseMove: TMouseMoveEvent;     FClickStart: Boolean;     CycleTimer: TTimer;           // For icon cycling     FIconIndex: Integer;          // Current index in imagelist     FDesignPreview: Boolean;     SettingPreview: Boolean;     FIconList: TImageList;     FCycleIcons: Boolean;     FCycleInterval: Cardinal;     OldAppProc, NewAppProc: Pointer;   // Procedure variables     FWindowHandle: HWND;               // Window handle (not general handle)     procedure SetCycleIcons(Value: Boolean);     procedure SetDesignPreview(Value: Boolean);     procedure SetCycleInterval(Value: Cardinal);     procedure TimerCycle(Sender: TObject);     procedure HandleIconMessage(var Msg: TMessage);     function InitIcon: Boolean;     procedure SetIcon(Value: TIcon);     procedure SetIconVisible(Value: Boolean);     procedure SetIconList(Value: TImageList);     procedure SetIconIndex(Value: Integer);     procedure SetHint(Value: String);     procedure PopupAtCursor;     procedure HookApp;     procedure UnhookApp;     procedure HookAppProc(var Msg: TMessage);   protected     IconData: TNotifyIconDataEx;    // Data of the tray icon wnd.     procedure Loaded; override;     function ShowIcon: Boolean; virtual;     function HideIcon: Boolean; virtual;     function ModifyIcon: Boolean; virtual;     procedure Click; dynamic;     procedure DblClick; dynamic;     procedure CycleIcon; dynamic;     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;       X, Y: Integer); dynamic;     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;       X, Y: Integer); dynamic;     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;     procedure Notification(AComponent: TComponent; Operation: TOperation);       override;   public {$IFDEF DFS_CPPB_3_UP}     property Handle: HWND read IconData.hWnd; {$ELSE}     property Handle: HWND read IconData.Wnd; {$ENDIF}     property WindowHandle: HWND read FWindowHandle;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     procedure Refresh;     function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;       TimeoutSecs: TBalloonHintTimeOut): Boolean;   published     // Properties:     property DesignPreview: Boolean read FDesignPreview       write SetDesignPreview default False;     property IconList: TImageList read FIconList write SetIconList;     property CycleIcons: Boolean read FCycleIcons write SetCycleIcons       default False;     property CycleInterval: Cardinal read FCycleInterval       write SetCycleInterval;     property Enabled: Boolean read FEnabled write FEnabled default True;     property Hint: String read FHint write SetHint;     property Icon: TIcon read FIcon write SetIcon stored True;     property IconVisible: Boolean read FIconVisible write SetIconVisible       default True;     property IconIndex: Integer read FIconIndex write SetIconIndex;     property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;     property LeftPopup: Boolean read FLeftPopup write FLeftPopup       default False;     property OnClick: TNotifyEvent read FOnClick write FOnClick;     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;     property OnCycle: TCycleEvent read FOnCycle write FOnCycle;   end; procedure Register; implementation {--------------------- TADTrayIcon ----------------------} constructor TADTrayIcon.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FIconVisible := True;      // Visible by default   FEnabled := True;          // Enabled by default   SettingPreview := False;   // Use the TaskbarCreated message available from Win98/IE4+   WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');   FIcon := TIcon.Create;   IconData.cbSize := SizeOf(TNotifyIconDataEx);   // IconData.wnd points to procedure to receive callback messages from the icon   IconData.wnd := AllocateHWnd(HandleIconMessage);   // Add an id for the tray icon   IconData.uId := IconID;   // We want icon, message handling, and tooltips by default   IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;   // Message to send to IconData.wnd when event occurs   IconData.uCallbackMessage := WM_TRAYNOTIFY;   FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);   CycleTimer := TTimer.Create(Self);   CycleTimer.Enabled := False;   CycleTimer.Interval := FCycleInterval;   CycleTimer.OnTimer := TimerCycle;   // Hook into the app.'s message handling   if not (csDesigning in ComponentState) then     HookApp; end; destructor TADTrayIcon.Destroy; begin   SetIconVisible(False);     // Remove the icon from the tray   FIcon.Free;                // Free the icon   DeallocateHWnd(IconData.Wnd);   // Free the tray window   CycleTimer.Free;   // It is important to unhook any hooked processes   if not (csDesigning in ComponentState) then     UnhookApp;   inherited Destroy; end; procedure TADTrayIcon.Loaded; { This method is called when all properties of the component have been   initialized. The method SetIconVisible must be called here, after the   tray icon (FIcon) has loaded itself. Otherwise, the tray icon will   be blank (no icon image). } begin   inherited Loaded;     // Always call inherited Loaded first   ModifyIcon;   SetIconVisible(FIconVisible); end; procedure TADTrayIcon.Notification(AComponent: TComponent;   Operation: TOperation); begin   inherited Notification(AComponent, Operation);   { Check if either the imagelist or the popup menu is about     to be deleted }   if (AComponent = IconList) and (Operation = opRemove) then   begin     FIconList := nil;     IconList := nil;   end;   if (AComponent = PopupMenu) and (Operation = opRemove) then   begin     FPopupMenu := nil;     PopupMenu := nil;   end; end; { For MinimizeToTray to work, we need to know when the form is minimized   (happens when either the application or the main form minimizes).   The straight-forward way is to make TADTrayIcon trap the   Application.OnMinimize event. However, if you also make use of this   event in the application, the OnMinimize code used by TADTrayIcon   is discarded.   The alternative is to hook into the app.'s message handling (via   HookApp). You can then catch any message that goes through the app.   and still use the OnMinimize event. } procedure TADTrayIcon.HookApp; begin   // Hook the application   OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));   NewAppProc := MakeObjectInstance(HookAppProc);   SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc)); end; procedure TADTrayIcon.UnhookApp; begin   if Assigned(OldAppProc) then     SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));   if Assigned(NewAppProc) then     FreeObjectInstance(NewAppProc);   NewAppProc := nil;   OldAppProc := nil; end; { All app. messages pass through HookAppProc. You can override the   messages by not passing them along to Windows (via CallWindowProc). } procedure TADTrayIcon.HookAppProc(var Msg: TMessage); begin   { Show the tray icon if the taskbar has been re-created after an     Explorer crash. }   if Msg.Msg = WM_TASKBARCREATED then     if FIconVisible then       ShowIcon;   // Pass the message on   Msg.Result := CallWindowProc(OldAppProc, Application.Handle,                 Msg.Msg, Msg.wParam, Msg.lParam); end; { HandleIconMessage handles messages that go to the shell notification   window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.   In these cases use lParam to get the actual message, eg. WM_MOUSEMOVE.   The method sends the usual Delphi events for the mouse messages. It also   interpolates the OnClick event when the user clicks the left button, and   makes the menu (if any) popup on left and right mouse down events. } procedure TADTrayIcon.HandleIconMessage(var Msg: TMessage);   function ShiftState: TShiftState;   // Return the state of the shift, ctrl, and alt keys   begin     Result := [];     if GetAsyncKeyState(VK_SHIFT) < 0 then       Include(Result, ssShift);     if GetAsyncKeyState(VK_CONTROL) < 0 then       Include(Result, ssCtrl);     if GetAsyncKeyState(VK_MENU) < 0 then       Include(Result, ssAlt);   end; var   Pt: TPoint;   Shift: TShiftState;   I: Integer;   M: TMenuItem; begin   if Msg.Msg = WM_TRAYNOTIFY then   // Take action if a message from the icon comes through   begin     case Msg.lParam of       WM_MOUSEMOVE:         if FEnabled then         begin           Shift := ShiftState;           GetCursorPos(Pt);           MouseMove(Shift, Pt.X, Pt.Y);         end;       WM_LBUTTONDOWN:         if FEnabled then         begin           Shift := ShiftState + [ssLeft];           GetCursorPos(Pt);           MouseDown(mbLeft, Shift, Pt.X, Pt.Y);           FClickStart := True;           if FLeftPopup then             PopupAtCursor;         end;       WM_RBUTTONDOWN:         if FEnabled then         begin           Shift := ShiftState + [ssRight];           GetCursorPos(Pt);           MouseDown(mbRight, Shift, Pt.X, Pt.Y);           PopupAtCursor;         end;       WM_MBUTTONDOWN:         if FEnabled then         begin           Shift := ShiftState + [ssMiddle];           GetCursorPos(Pt);           MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);         end;       WM_LBUTTONUP:         if FEnabled then         begin           Shift := ShiftState + [ssLeft];           GetCursorPos(Pt);           if FClickStart then       // Then WM_LBUTTONDOWN was called before           begin             FClickStart := False;             Click;                  // We have a click           end;           MouseUp(mbLeft, Shift, Pt.X, Pt.Y);         end;       WM_RBUTTONUP:         if FEnabled then         begin           Shift := ShiftState + [ssRight];           GetCursorPos(Pt);           MouseUp(mbRight, Shift, Pt.X, Pt.Y);         end;       WM_MBUTTONUP:         if FEnabled then         begin           Shift := ShiftState + [ssMiddle];           GetCursorPos(Pt);           MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);         end;       WM_LBUTTONDBLCLK:         if FEnabled then         begin           DblClick;           { Handle default menu items. But only if LeftPopup is false,             or it will conflict with the popupmenu, when it is called             by a click event. }           M := nil;           if Assigned(FPopupMenu) then             if (FPopupMenu.AutoPopup) and (not FLeftPopup) then               for I := PopupMenu.Items.Count -1 downto 0 do               begin                 if PopupMenu.Items.Default then                   M := PopupMenu.Items;               end;           if M <> nil then             M.Click;         end;       end;   end   else        // Messages that didn't go through the icon     case Msg.Msg of       { Windows sends us a WM_QUERYENDSESSION message when it prepares         for shutdown. Msg.Result must not return 0, or the system will         be unable to shut down. }       WM_QUERYENDSESSION: begin //showmessage('WM_QUERYENDSESSION'); //        PostQuitMessage(0);         Msg.Result := 1;       end; {       WM_DESTROY: begin showmessage('WM_DESTROY');         PostQuitMessage(0);         Msg.Result := 0;       end; } {       WM_ENDSESSION: begin //showmessage('WM_ENDSESSION');         Msg.Result := 0;       end; }     else      // Handle all other messages with the default handler       Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);     end; end; procedure TADTrayIcon.SetIcon(Value: TIcon); begin   FIcon.Assign(Value);   ModifyIcon; end; procedure TADTrayIcon.SetIconVisible(Value: Boolean); begin   if Value then     ShowIcon   else     HideIcon; end; procedure TADTrayIcon.SetDesignPreview(Value: Boolean); begin   FDesignPreview := Value;   SettingPreview := True;         // Raise flag   SetIconVisible(Value);   SettingPreview := False;        // Clear flag end; procedure TADTrayIcon.SetCycleIcons(Value: Boolean); begin   FCycleIcons := Value;   if Value then     SetIconIndex(0);   CycleTimer.Enabled := Value; end; procedure TADTrayIcon.SetCycleInterval(Value: Cardinal); begin   FCycleInterval := Value;   CycleTimer.Interval := FCycleInterval; end; procedure TADTrayIcon.SetIconList(Value: TImageList); begin   FIconList := Value; {   // Set CycleIcons = false if IconList is nil   if Value = nil then     SetCycleIcons(False); }   SetIconIndex(0); end; procedure TADTrayIcon.SetIconIndex(Value: Integer); begin   if FIconList <> nil then   begin     FIconIndex := Value;     if Value >= FIconList.Count then       FIconIndex := FIconList.Count -1;     FIconList.GetIcon(FIconIndex, FIcon);   end   else     FIconIndex := 0;   ModifyIcon; end; procedure TADTrayIcon.SetHint(Value: String); begin   FHint := Value;   ModifyIcon; end; function TADTrayIcon.InitIcon: Boolean; // Set icon and tooltip var   ok: Boolean; begin   Result := False;   ok := True;   if (csDesigning in ComponentState) and SettingPreview then     ok := FDesignPreview;   if ok then   begin     IconData.hIcon := FIcon.Handle;     if FHint <> '' then       StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip)-1)       // StrLCopy must be used since szTip is only 64 bytes     else       IconData.szTip := '';     Result := True;   end; end; function TADTrayIcon.ShowIcon: Boolean; // Add/show the icon on the tray begin   Result := False;   if not SettingPreview then     FIconVisible := True;   begin     if (csDesigning in ComponentState) {or      (csLoading in ComponentState)} then     begin       if SettingPreview then         if InitIcon then           Result := Shell_NotifyIcon(NIM_ADD, @IconData);     end     else     if InitIcon then       Result := Shell_NotifyIcon(NIM_ADD, @IconData);   end; end; function TADTrayIcon.HideIcon: Boolean; // Remove/hide the icon from the tray begin   Result := False;   if not SettingPreview then     FIconVisible := False;   begin     if (csDesigning in ComponentState) {or      (csLoading in ComponentState)} then     begin       if SettingPreview then         if InitIcon then           Result := Shell_NotifyIcon(NIM_DELETE, @IconData);     end     else     if InitIcon then       Result := Shell_NotifyIcon(NIM_DELETE, @IconData);   end; end; function TADTrayIcon.ModifyIcon: Boolean; // Change icon or tooltip if icon already placed begin   Result := False;   if InitIcon then     Result := Shell_NotifyIcon(NIM_MODIFY, @IconData); end; procedure TADTrayIcon.TimerCycle(Sender: TObject); begin   if Assigned(FIconList) then   begin     FIconList.GetIcon(FIconIndex, FIcon);     CycleIcon;                    // Call event method     ModifyIcon;     if FIconIndex < FIconList.Count-1 then       SetIconIndex(FIconIndex+1)     else       SetIconIndex(0);   end; end; function TADTrayIcon.ShowBalloonHint(Title: String; Text: String;   IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean; const   aBalloonIconTypes: array[TBalloonHintIcon] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR); begin   if FEnabled then   begin     // Remove old balloon hint     with IconData do     begin       uFlags := uFlags or NIF_INFO;       StrPCopy(szInfo, '');     end;     ModifyIcon;     // Display new balloon hint     with IconData do     begin       uFlags := uFlags or NIF_INFO;       StrPCopy(szInfo, Text);       StrPCopy(szInfoTitle, Title);       uTimeout := TimeoutSecs * 1000;       dwInfoFlags := aBalloonIconTypes[IconType];     end;     Result := ModifyIcon;     { Remove NIF_INFO before next call to ModifyIcon (or else the balloon hint       will redisplay itself) }     with IconData do       uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;   end   else     Result := True; end; procedure TADTrayIcon.Refresh; // Refresh the icon begin   ModifyIcon; end; procedure TADTrayIcon.PopupAtCursor; var   CursorPos: TPoint; begin   if Assigned(PopupMenu) then     if PopupMenu.AutoPopup then       if GetCursorPos(CursorPos) then       begin         { Win98 (but not Win95/WinNT) seems to empty a popup menu before           closing it. This is a problem when the menu is about to display           while it already is active (two click-events in succession). The           menu will flicker annoyingly. Calling ProcessMessages fixes this. }         Application.ProcessMessages;         { Bring the main form or its modal dialog to the foreground.           This also ensures the popup menu closes after it loses focus. }         SetForegroundWindow((Owner as TWinControl).Handle); { This seems unnecessary(?):         if Screen.ActiveControl <> nil then           if (Screen.ActiveControl.Owner is TWinControl) then             SetForegroundWindow((Screen.ActiveControl.Owner as TWinControl).Handle); }         // Now make the menu pop up         PopupMenu.PopupComponent := Self;         PopupMenu.Popup(CursorPos.X, CursorPos.Y);         // Post an empty message to make the popup menu disappear         PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0);       end; end; procedure TADTrayIcon.Click; begin   // Execute user-assigned method   if Assigned(FOnClick) then     FOnClick(Self); end; procedure TADTrayIcon.DblClick; begin   // Execute user-assigned method   if Assigned(FOnDblClick) then     FOnDblClick(Self); end; procedure TADTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;   X, Y: Integer); begin   // Execute user-assigned method   if Assigned(FOnMouseDown) then     FOnMouseDown(Self, Button, Shift, X, Y); end; procedure TADTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;   X, Y: Integer); begin   // Execute user-assigned method   if Assigned(FOnMouseUp) then     FOnMouseUp(Self, Button, Shift, X, Y); end; procedure TADTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer); begin   // Execute user-assigned method   if Assigned(FOnMouseMove) then     FOnMouseMove(Self, Shift, X, Y); end; procedure TADTrayIcon.CycleIcon; var   NextIconIndex: Integer; begin   // Execute user-assigned method   NextIconIndex := 0;   if FIconList <> nil then     if FIconIndex < FIconList.Count then       NextIconIndex := FIconIndex +1;   if Assigned(FOnCycle) then     FOnCycle(Self, NextIconIndex); end; procedure Register; begin   RegisterComponents('Adnil Studio', [TADTrayIcon]); end; end.

delphiwolf · 2001-12-28

PRB: Menus for Notification Icons Do Not Work Correctly -------------------------------------------------------------------------------- The information in this article applies to: Microsoft Win32 Software Development Kit (SDK) -------------------------------------------------------------------------------- SYMPTOMS When you display a context menu for a notification icon (see Shell_NotifyIcon), clicking anywhere besides the menu or the window that created the menu (if it is visible) doesn't cause the menu to disappear. When this behavior is corrected, the second time this menu is displayed, it displays and then immediately disappears. RESOLUTION To correct the first behavior, you need to make the current window the foreground window before calling TrackPopupMenu or TrackPopupMenuEx. The second problem is caused by a problem with TrackPopupMenu. It is necessary to force a task switch to the application that called TrackPopupMenu at some time in the near future. This can be accomplished by posting a benign message to the window or thread. The following code will take care of all of this:    [red]SetForegroundWindow(hDlg);[/red]    // Display the menu    TrackPopupMenu(   hSubMenu,                      TPM_RIGHTBUTTON,                      pt.x,                      pt.y,                      0,                      hDlg,                      NULL);    PostMessage(hDlg, WM_NULL, 0, 0); STATUS This behavior is by design. Additional query words: Keywords : kbcode kbLib kbMenu kbNTOS400 kbWinOS95 kbWinOS98 kbshell Version : WINDOWS: Platform : WINDOWS Issue type : kbprb Technology : Last Reviewed: January 6, 2000 &copy; 2000 Microsoft Corporation. All rights reserved. Terms of Use.   -------------------------------------------------------------------------------- Send feedback to MSDN.Look here for MSDN Online resources.

DDK · 2001-12-28

多人接受答案了。

对TrackPopupMenu不懂(100分)

DDK

Unregistered / Unconfirmed

Adnil

Unregistered / Unconfirmed

delphiwolf

Unregistered / Unconfirmed

DDK

Unregistered / Unconfirmed

Similar threads