托盘图标挂载右键菜单 ( 积分: 100 )

wgliang2004 · 2005-11-10

将应用程序缩小为一个托盘图标后， 希望能够通过右键点出菜单，请各位大虾指教 小弟是位初学者，现暂无相关资料可以查，先谢谢了!~~

wgliang2004 · 2005-11-10

将应用程序缩小为一个托盘图标后， 希望能够通过右键点出菜单，请各位大虾指教 小弟是位初学者，现暂无相关资料可以查，先谢谢了!~~

hfghfghfg · 2005-11-10

TRzTrayIcon raize 控件包自己下载

wangminqi · 2005-11-10

unit TrayIcon; interface uses    Menus,windows,Types,Forms,Messages,SysUtils, Classes ,Graphics,ExtCtrls,ShellAPI,Controls; const WM_SYSTEM_TRAY_NOTIFY = WM_USER + 100; type TTrayIconMessage=(imClick, imDoubleClick, imMouseDown,                       imMouseUp, imLeftClickUp, imLeftDoubleClick,                       imRightClickUp, imRightDoubleClick, imNone);  TTrayIcon = class(TComponent)  private       FVisible:boolean;       FHide:boolean;       FIconList:TImageList;       FData:TNotifyIconData;       FIsClicked:boolean;       FIcon:Ticon;       FTimer:TTimer;       FAnimate:boolean;       FIconIndex:integer;       FPopupMenu:TPopupMenu;       FHint:String ;       FAppRestore:TTrayIconMessage;       FPopupMenuShow:TTrayIconMessage;       FApplicationHook:TWindowHook;       FOnClick:TNotifyEvent;       FOnMinimize:TNotifyEvent;       FOnRestore:TNotifyEvent;       FOnMouseMove:TMouseMoveEvent;       FOnMouseExit:TMouseMoveEvent;       FOnMouseEnter:TMouseMoveEvent;       FOnDblClick:TNotifyEvent;       FOnMouseDown:TMouseEvent;       FOnMouseUp:TMouseEvent;       FOnAnimate:TNotifyEvent;       FOnCreate:TNotifyEvent;       FOnDestroy:TNotifyEvent;       FOnActivate:TNotifyEvent;       FOnDeactivate:TNotifyEvent;       procedure SetHint(Hint:String);       procedure SetHide(Value:boolean);       procedure EndSession;       function GetAnimateInterval:integer;       procedure SetAnimateInterval(Value:integer);       function GetAnimate:boolean;       procedure SetAnimate(Value:boolean);       function ShiftState:TShiftState;    { Private declarations }  protected       procedure DoClick();       procedure DoDblClick();       procedure DoOnAnimate(Sender:TObject);virtual;       procedure DoMouseMove(Shift:TShiftState;X:integer;Y:integer);virtual;       procedure DoMouseDown(Button:TMouseButton;Shift:TShiftState;X:integer;Y:integer);       procedure DoMouseUp(Button:TMouseButton;Shift:TShiftState;X:integer;Y:integer);       procedure SetVisible(Value:boolean);virtual;       procedure DoMessage(var Message: TMessage);//message WM_SYSTEM_TRAY_NOTIFY;       function ApplicationHookProc(var Message: TMessage):boolean;       procedure Notification(AComponent:TComponent;Operation: TOperation);override;       procedure Loaded; override;       property Data:TNotifyIconData read FData;    { Protected declarations }  public       constructor Create(AOwner: TComponent); override;       destructor Destroy; override;       procedure Update;virtual;       procedure Minimize;virtual;       procedure Restore;virtual;       procedure ShowMenu;virtual;       procedure SetIconIndex(Value:integer);virtual;       procedure SetDefaultIcon;virtual;       function GetHandle:HWND;    { Public declarations }  published      property IconIndex:integer read FIconIndex write SetIconIndex default 0;      property Visible:boolean read FVisible write SetVisible default false;      property Hide:boolean read FHide write SetHide;      property Hint:String read FHint write SetHint;      property PopupMenu:TPopupMenu read FPopupMenu write FPopupMenu;      property RestoreOn:TTrayIconMessage read FAppRestore write FAppRestore;      property PopupMenuOn:TTrayIconMessage read FPopupMenuShow write FPopupMenuShow;      property Icons:TImageList read FIconList write FIconList;      property AnimateInterval:integer read GetAnimateInterval write SetAnimateInterval default 1000;      property Animate:boolean read GetAnimate write SetAnimate default false;      property Handle:HWND read GetHandle;   // Events      property OnMinimize:TNotifyEvent read FOnMinimize write FOnMinimize;      property OnRestore:TNotifyEvent read FOnRestore write FOnRestore;      property OnClick:TNotifyEvent read FOnClick write FOnClick;      property OnMouseEnter:TMouseMoveEvent read FOnMouseEnter write FOnMouseEnter;      property OnMouseExit:TMouseMoveEvent read FOnMouseExit write FOnMouseExit;      property OnMouseMove:TMouseMoveEvent read FOnMouseMove write FOnMouseMove;      property OnMouseUp:TMouseEvent read FOnMouseUp write FOnMouseUp;      property OnMouseDown:TMouseEvent read FOnMouseDown write FOnMouseDown;      property OnAnimate:TNotifyEvent read FOnAnimate write FOnAnimate;      property OnCreate:TNotifyEvent read FOnCreate write FOnCreate;      property OnDestroy:TNotifyEvent read FOnDestroy write FOnDestroy;      property OnActivate:TNotifyEvent read FOnActivate write FOnActivate;      property OnDeactivate:TNotifyEvent read FOnDeactivate write FOnDeactivate;    { Published declarations }  end; procedure Register; implementation procedure Register; begin  RegisterComponents('Samples', [TTrayIcon]); end; procedure TTrayIcon.DoOnAnimate(Sender:TObject); begin   if (IconIndex < FIconList.Count-1) then      inc(FIconIndex)   else      FIconIndex := 0;   SetIconIndex(FIconIndex);   Update; end; procedure TTrayIcon.SetHide(Value:boolean); begin   FHide := Value; end; procedure TTrayIcon.SetIconIndex(Value:integer); begin   FIconIndex := Value;   if assigned(FIconList) then      FIconList.GetIcon(FIconIndex, FIcon);   Update; end; constructor TTrayIcon.Create(AOwner: TComponent); begin   inherited;   FIcon := TIcon.CREATE ;   FTimer := TTimer.Create(nil);   FIconIndex:= 0;   FIcon.Assign(Application.Icon);   FAppRestore := imDoubleClick;   FOnAnimate := DoOnAnimate;   FPopupMenuShow := imNone;   FVisible := false;   FHide := true;   FTimer.Enabled := false;   FTimer.OnTimer := OnAnimate;   FTimer.Interval := 1000;   if (not (csDesigning in ComponentState)) then   begin      FData.cbSize := sizeof(TNotifyIconData);      FData.Wnd := AllocateHWnd(DoMessage);      FData.uID := integer(self);      FData.hIcon := FIcon.Handle;      FData.uFlags := NIF_ICON or NIF_MESSAGE;      FData.uCallbackMessage := WM_SYSTEM_TRAY_NOTIFY;      FApplicationHook := ApplicationHookProc;      Update;   end; end; destructor TTrayIcon.Destroy; begin   if (not (csDesigning in ComponentState)) then   begin      Shell_NotifyIcon(NIM_DELETE, @FData);      DeallocateHWnd(FData.Wnd);   end;   if assigned(FIcon) then      FIcon.free;   if assigned(FTimer) then      FTimer.free;   inherited; end; procedure TTrayIcon.Update; begin   if (not (csDesigning in ComponentState))  then   begin      FData.hIcon := FIcon.Handle;      if (Visible = true) then         Shell_NotifyIcon(NIM_MODIFY, @FData);   end; end; procedure TTrayIcon.SetVisible(Value:boolean); begin   FVisible := Value;   if (not (csDesigning in ComponentState)) then   begin      if (FVisible) then      begin         if (not Shell_NotifyIcon(NIM_ADD, @FData)) then            raise EOutOfResources.Create('Cannot create!');         Hide := true;         Application.HookMainWindow(FApplicationHook);      end      else      begin         if (not Shell_NotifyIcon(NIM_DELETE, @FData)) then            raise EOutOfResources.Create('Cannot move!');;         Hide := false;         Application.UnhookMainWindow(FApplicationHook);      end;   end; end; procedure TTrayIcon.EndSession; begin   Shell_NotifyIcon(NIM_DELETE, @FData); end; procedure TTrayIcon.DoMessage(var Message:TMessage); var   point:TPoint;   shift:TShiftState; begin   case Message.Msg of   WM_QUERYENDSESSION:         Message.Result := 1;   WM_ENDSESSION:         EndSession;   WM_SYSTEM_TRAY_NOTIFY:   begin        case Message.LParam of        WM_MOUSEMOVE:             if assigned(FOnClick) then             begin                shift := ShiftState;                GetCursorPos(point);                DoMouseMove(shift, point.x, point.y);             end;        WM_LBUTTONDOWN:        begin             shift := ShiftState;             shift:= shift+[ssLeft];             GetCursorPos(point);             DoMouseDown(mbLeft, shift, point.x, point.y);             FIsClicked := true;        end;        WM_LBUTTONUP:        begin             shift := ShiftState;             shift :=shift+[ssLeft];             GetCursorPos(point);             if assigned(FOnClick) then                DoClick;             DoMouseUp(mbLeft, shift, point.x, point.y);             if (FAppRestore = imLeftClickUp) then                Restore;             if (FPopupMenuShow = imLeftClickUp) then                ShowMenu;        end;        WM_LBUTTONDBLCLK:        begin           DoDblClick;           if (FAppRestore = imLeftDoubleClick) then              Restore;           if (FPopupMenuShow = imLeftDoubleClick) then              ShowMenu;        end;        WM_RBUTTONDOWN:        begin           shift := ShiftState;           shift:= shift+[ssRight];           GetCursorPos(point);           DoMouseDown(mbRight, shift, point.x, point.y);        end;        WM_RBUTTONUP:        begin           shift:= ShiftState;           shift:=shift+[ssRight];           GetCursorPos(point);           DoMouseUp(mbRight, shift, point.x, point.y);           if (FAppRestore = imRightClickUp) then              Restore;           if (FPopupMenuShow = imRightClickUp) then              ShowMenu;        end;        WM_RBUTTONDBLCLK:        begin           DoDblClick;           if (FAppRestore = imRightDoubleClick) then              Restore;           if (FPopupMenuShow = imRightDoubleClick) then              ShowMenu;        end;        WM_MBUTTONDOWN:        begin           shift := ShiftState;           shift:=shift+[ssMiddle];           GetCursorPos(point);           DoMouseDown(mbMiddle, shift, point.x, point.y);        end;        WM_MBUTTONUP:        begin           shift := ShiftState;           shift:=shift+[ssMiddle];           GetCursorPos(point);           DoMouseUp(mbMiddle, shift, point.x, point.y);        end;        WM_MBUTTONDBLCLK:           DoDblClick();        end;   end;   end;   inherited Dispatch(Message); end; procedure TTrayIcon.DoClick; begin   if (FAppRestore = imClick) then      Restore;   if (FPopupMenuShow = imClick) then      ShowMenu;   if assigned(FOnClick) then      FOnClick(self); end; procedure TTrayIcon.DoDblClick; begin   if (FAppRestore = imDoubleClick) then      Restore;   if (FPopupMenuShow = imDoubleClick) then      ShowMenu;   if assigned(FOnDblClick) then      FOnDblClick(self); end; procedure TTrayIcon.DoMouseMove(Shift:TShiftState;X:integer;Y:integer); begin   if assigned(FOnMouseMove) then      FOnMouseMove(self, Shift, X, Y); end; procedure TTrayIcon.DoMouseDown(Button:TMouseButton;Shift:TShiftState;                                       X:integer;Y:integer); begin   if (FAppRestore = imMouseDown) then      Restore;   if (FPopupMenuShow = imMouseDown) then      ShowMenu;   if assigned(FOnMouseDown) then      FOnMouseDown(self, Button, Shift, X, Y); end; procedure TTrayIcon.DoMouseUp(Button:TMouseButton ;Shift:TShiftState;                                     X:integer;Y:integer); begin   if (FAppRestore = imMouseDown) then      Restore;   if (FPopupMenuShow = imMouseDown) then      ShowMenu;   if assigned(FOnMouseUp) then      FOnMouseUp(self, Button, Shift, X, Y); end; function TTrayIcon.ApplicationHookProc(var Message:TMessage):boolean; begin   if (Message.Msg = WM_SYSCOMMAND) then   begin      if (Message.WParam = SC_MINIMIZE) then         Minimize;      if (Message.WParam = SC_RESTORE) then         Restore;   end;   result:= false; end; procedure TTrayIcon.Minimize; begin   Application.Minimize;   ShowWindow(Application.Handle, SW_HIDE);   if assigned(FOnMinimize) then      FOnMinimize(self); end; procedure TTrayIcon.Restore; begin   Application.Restore;   ShowWindow(Application.Handle, SW_RESTORE);   SetForegroundWindow(Application.Handle);   if assigned(FOnRestore) then      FOnRestore(self); end; procedure TTrayIcon.ShowMenu; var Point:Tpoint; begin   GetCursorPos(point);   try      if (Screen.ActiveForm.Handle <>0) then         SetForegroundWindow(Screen.ActiveForm.Handle);   except   end;   FPopupMenu.Popup(point.x, point.y); end; procedure TTrayIcon.SetDefaultIcon; begin  FIcon.Assign(Application.Icon);  Update; end; procedure TTrayIcon.Notification(AComponent:TComponent;Operation:TOperation); begin  inherited Notification(AComponent, Operation);  if (Operation = opRemove) then  begin     if (AComponent = FIconList) then       FIconList := nil     else if (AComponent = FPopupMenu) then       FPopupMenu := nil;  end; end; procedure TTrayIcon.Loaded; begin   inherited Loaded;   if not assigned( FIconList) then   begin      FAnimate := false;      FIcon.Assign(Application.Icon);   end   else   begin      FTimer.Enabled := FAnimate;      FIconList.GetIcon(FIconIndex, FIcon);   end;   Update; end; procedure TTrayIcon.SetHint(Hint:String); begin   // The new hint must be different than the previous hint and less than   // 64 characters to be modified. 64 is an operating system limit.   if ((FHint <> Hint) and (length(Hint) < 64)) then   begin      FHint := Hint;      StrPLCopy(FData.szTip, Hint, sizeof(FData.szTip) - 1);      // If there is no hint then there is no tool tip.      if Length(Hint)>0 then         FData.uFlags := FData.uFlags or NIF_TIP      else         FData.uFlags := FData.uFlags and (not NIF_TIP);      Update;   end; end; function TTrayIcon.GetAnimateInterval:integer; begin   result:= FTimer.Interval; end; procedure TTrayIcon.SetAnimateInterval(Value:integer); begin   FTimer.Interval := Value; end; function TTrayIcon.GetAnimate:boolean; begin   result:=FAnimate; end; procedure TTrayIcon.SetAnimate(Value:boolean); begin   if (assigned(FIconList) or (csLoading in ComponentState)) then      FAnimate := Value;   if (assigned(FIconList) and (not (csDesigning in ComponentState))) then      FTimer.Enabled := Value; end; function TTrayIcon.ShiftState:TShiftState; begin   if (GetKeyState(VK_SHIFT) < 0) then      result:=result+[ssShift];   if (GetKeyState(VK_CONTROL) < 0) then      result:=result+[ssCtrl];   if (GetKeyState(VK_MENU) < 0) then      result:=result+[ssAlt]; end; function TTrayIcon.GetHandle:HWND; begin   result:= FData.Wnd; end; end.

xianguo · 2005-11-10

TrayIcon1.PopupMenu := PopupMenu1;

wgliang2004 · 2005-11-11

学习中。。。 谢谢！

mysirius · 2005-11-11

//函数声明： procedure IconOnClick(var Msg: TMessage); message MI_ICONEVENT; procedure WMSysCommand(var msg: TWMSysCommand); message WM_SysCommand; procedure TFrmMain.WMSysCommand(var msg: TWMSysCommand); begin  if msg.CmdType and $FFF0 = SC_MINIMIZE then    begin      FrmMain.WindowState:=wsMinimized;      hide;    end  else    inherited; end; //图标的响应函数 procedure TFrmMain.IconOnClick; var  pt: TPoint; begin  if (Msg.LParam= WM_LBUTTONDOWN) then     begin       FrmMain.Show;       FrmMain.WindowState:=wsNormal;       SetForegroundWindow(FrmMain.Handle);     end;  if  (Msg.LParam= WM_RBUTTONDOWN) then    begin      GetCursorPos(pt);      TMenu.Popup(pt.x, pt.y);    end; end;

wgliang2004 · 2005-11-12

谢谢 wangminqi&mysirius两位大虾， 我的问题已经解决了，呵~~

托盘图标挂载右键菜单 ( 积分: 100 )

wgliang2004

Unregistered / Unconfirmed

wgliang2004

Unregistered / Unconfirmed

hfghfghfg

Unregistered / Unconfirmed

wangminqi

Unregistered / Unconfirmed

xianguo

Unregistered / Unconfirmed

wgliang2004

Unregistered / Unconfirmed

mysirius

Unregistered / Unconfirmed

wgliang2004

Unregistered / Unconfirmed

Similar threads