完整版
// iamy
// 2005.8
// MNotifyIcon
unit MNotifyIcon;
interface
uses
Windows, ShellApi, Classes, Messages,
Graphics, SysUtils,
Dialogs, Controls,
Menus, Forms, ExtCtrls;
const
WM_MNotifyIcon = WM_USER + 1;
Icon_Flag = (NIF_ICON or NIF_MESSAGE or NIF_TIP);
Type
TMCustomNotifyIcon = Class (TComponent)
Private
FNotifyIconData : TNotifyIconData;
FWnd: HWnd;
FhIcon: HICON;
FuId: Cardinal;
FuFlags: Cardinal;
FuCallbackMessage: Cardinal;
FszTip: array [0..63] of char;
FActive: Boolean;
procedure SethIcon(const Value: HICON);
procedure SetszTip(const Value: String);
function GetszTip: String;
procedure SetActive(const Value: Boolean);
procedure WndProc(var MsgCB: TMessage);
procedure WMMNotifyIcon(var Msg: TMessage); message WM_MNotifyIcon;
procedure ProcIconMessage(var Msg: TMessage); virtual; Abstract;
protected
procedure PrepareNotifyIconData; Virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Active:Boolean Read FActive Write SetActive default False;
property hIcon:HICON read FhIcon write SethIcon;
property szTip:String read GetszTip write SetszTip;
function ShowNotifyIcon:Boolean; Virtual;
function HideNotifyIcon:Boolean; Virtual;
function UpdateNotifyIcon:Boolean; Virtual;
end;
TMControlNotifyIcon = class(TMCustomNotifyIcon)
private
FIcon: TIcon;
FlDown: Boolean;
FrDown: Boolean;
FmDown: Boolean;
FOnMouseUp: TMouseEvent;
FOnMouseDown: TMouseEvent;
FOnMouseExit: TMouseMoveEvent;
FOnMouseEnter: TMouseMoveEvent;
FOnMouseMove: TMouseMoveEvent;
FOnActivate: TNotifyEvent;
FOnlClick: TNotifyEvent;
FOnCreate: TNotifyEvent;
FOnDeactivate: TNotifyEvent;
FOnDestroy: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnUpdateData: TNotifyEvent;
FOnrClick: TNotifyEvent;
FOnDbrClick: TNotifyEvent;
FOnmClick: TNotifyEvent;
FOnDbmClick: TNotifyEvent;
procedure SetIcon(const Value: TIcon);
procedure ProcIconMessage(var Msg: TMessage); override;
procedure SetOnActivate(const Value: TNotifyEvent);
procedure SetOnlClick(const Value: TNotifyEvent);
procedure SetOnCreate(const Value: TNotifyEvent);
procedure SetOnDblClick(const Value: TNotifyEvent);
procedure SetOnDeactivate(const Value: TNotifyEvent);
procedure SetOnDestroy(const Value: TNotifyEvent);
procedure SetOnMouseDown(const Value: TMouseEvent);
procedure SetOnMouseEnter(const Value: TMouseMoveEvent);
procedure SetOnMouseExit(const Value: TMouseMoveEvent);
procedure SetOnMouseMove(const Value: TMouseMoveEvent);
procedure SetOnMouseUp(const Value: TMouseEvent);
function ShiftState:TShiftState;
procedure SetOnUpdateData(const Value: TNotifyEvent);
procedure SetOnrClick(const Value: TNotifyEvent);
procedure SetOnDbrClick(const Value: TNotifyEvent);
procedure SetOnmClick(const Value: TNotifyEvent);
procedure SetOnDbmClick(const Value: TNotifyEvent);
protected
procedure DolClick; virtual;
procedure DorClick; virtual;
procedure DomClick; virtual;
procedure DoDblClick; virtual;
procedure DoDbrClick; virtual;
procedure DoDbmClick; virtual;
procedure DoMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure DoMouseExit(Shift: TShiftState; X, Y: Integer); virtual;
procedure DoMouseEnter(Shift: TShiftState; X, Y: Integer); virtual;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ShowNotifyIcon:Boolean; override;
function HideNotifyIcon:Boolean; override;
function UpdateNotifyIcon:Boolean; override;
published
property Icon:TIcon read FIcon write SetIcon;
property Active;
property szTip;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove;
property OnMouseExit: TMouseMoveEvent read FOnMouseExit write SetOnMouseExit;
property OnMouseEnter: TMouseMoveEvent read FOnMouseEnter write SetOnMouseEnter;
property OnlClick: TNotifyEvent read FOnlClick write SetOnlClick;
property OnrClick: TNotifyEvent read FOnrClick write SetOnrClick;
property OnmClick: TNotifyEvent read FOnmClick write SetOnmClick;
property OnDblClick: TNotifyEvent read FOnDblClick write SetOnDblClick;
property OnDbrClick: TNotifyEvent read FOnDbrClick write SetOnDbrClick;
property OnDbmClick: TNotifyEvent read FOnDbmClick write SetOnDbmClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write SetOnMouseUp;
property OnCreate: TNotifyEvent read FOnCreate write SetOnCreate;
property OnDestroy: TNotifyEvent read FOnDestroy write SetOnDestroy;
property OnActivate: TNotifyEvent read FOnActivate write SetOnActivate;
property OnDeactivate: TNotifyEvent read FOnDeactivate write SetOnDeactivate;
property OnUpdateData: TNotifyEvent read FOnUpdateData write SetOnUpdateData;
end;
TNotifyIconPopMenuOn = (NIPM_lUp, NIPM_rUp, NIPM_mUp);
TNotifyIconPopMenuOns = Set of TNotifyIconPopMenuon;
TNotifyIconAppRestoreOn = (NIAR_lClick, NIAR_rClick, NIAR_mClick,
NIAR_DblClick, NIAR_DbrClick, NIAR_DbmClick);
TNotifyIconAppRestoreOns = Set of TNotifyIconAppRestoreOn;
TMNotifyIcon = Class(TMControlNotifyIcon)
Private
FIconList: TImageList;
FIconIndex: Integer;
FPopupMenu: TPopupMenu;
FHookProc: TWindowHook;
FMenuPopupOn: TNotifyIconPopMenuOns;
FHideOnMinimSize: Boolean;
FAppRestoreOn: TNotifyIconAppRestoreOns;
FAppHide: Boolean;
procedure SetIconList(const Value: TImageList);
procedure SetIconIndex(const Value: Integer);
procedure SetPopupMenu(const Value: TPopupMenu);
procedure ShowPopMenu(Const X,Y:Integer);
procedure SetMenuPopupOn(const Value: TNotifyIconPopMenuOns);
procedure SetHideOnMinimSize(const Value: Boolean);
procedure SetAppRestoreOn(const Value: TNotifyIconAppRestoreOns);
procedure HiddApp;
procedure RestoreApp;
protected
procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure DolClick; override;
procedure DorClick; override;
procedure DomClick; override;
procedure DoDblClick; override;
procedure DoDbrClick; override;
procedure DoDbmClick; override;
procedure Loaded; override;
function HookProcess(var Message: TMessage): Boolean; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property IconList: TImageList read FIconList write SetIconList;
property IconIndex: Integer read FIconIndex write SetIconIndex Default 0;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property MenuPopupOn: TNotifyIconPopMenuOns read FMenuPopupOn write SetMenuPopupOn;
property HideOnMinimSize:Boolean read FHideOnMinimSize write SetHideOnMinimSize;
property AppRestoreOn: TNotifyIconAppRestoreOns read FAppRestoreOn write SetAppRestoreOn;
function ShowNotifyIcon:Boolean; override;
function HideNotifyIcon:Boolean; override;
end;
implementation
{ TMCustomNotifyIcon }
constructor TMCustomNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := False;
FWnd:=Classes.AllocateHWND(WndProc);
FuCallbackMessage:=WM_MNotifyIcon;
FuFlags:=Icon_Flag;
end;
destructor TMCustomNotifyIcon.Destroy;
begin
If FActive then
HideNotifyIcon;
Classes.DeAllocateHWND(FWnd);
inherited Destroy;
end;
function TMCustomNotifyIcon.GetszTip: String;
begin
Result:=FszTip;
end;
function TMCustomNotifyIcon.HideNotifyIcon:Boolean;
begin
//PrepareNotifyIconData;
Result := Shell_NotifyIcon(NIM_DELETE,@FNotifyIconData);
end;
procedure TMCustomNotifyIcon.PrepareNotifyIconData;
begin
ZeroMemory(@FNotifyIconData,SizeOf(FNotifyIconData));
FNotifyIconData.Wnd := FWnd;
FNotifyIconData.hIcon := FhIcon;
FNotifyIconData.uID := FuID;
FNotifyIconData.uFlags := Icon_Flag;
FNotifyIconData.uCallbackMessage := FuCallbackMessage;
StrCopy(FNotifyIconData.szTip,FszTip);
FNotifyIconData.cbSize:=SizeOf(TNotifyIconData);
end;
procedure TMCustomNotifyIcon.SetActive(const Value: Boolean);
begin
FActive := Value;
if not (csDesigning in self.ComponentState) then
if Value then
begin
FActive := ShowNotifyIcon;
end else
begin
FActive := not HideNotifyIcon;
end;
end;
procedure TMCustomNotifyIcon.SethIcon(const Value: HICON);
begin
FhIcon := Value;
If Active then
Self.UpdateNotifyIcon;
end;
procedure TMCustomNotifyIcon.SetszTip(const Value: String);
begin
ZeroMemory(@FszTip,SizeOf(FszTip));
StrCopy(FszTip,Pchar(Value));
If Active then
Self.UpdateNotifyIcon;
end;
function TMCustomNotifyIcon.ShowNotifyIcon:Boolean;
begin
PrepareNotifyIconData;
Result := Shell_NotifyIcon(NIM_ADD,@FNotifyIconData);
end;
function TMCustomNotifyIcon.UpdateNotifyIcon: Boolean;
begin
PrepareNotifyIconData;
Result := Shell_NotifyIcon(NIM_MODIFY,@FNotifyIconData);
end;
procedure TMCustomNotifyIcon.WMMNotifyIcon(var Msg: TMessage);
begin
Self.ProcIconMessage(Msg);
end;
procedure TMCustomNotifyIcon.WndProc(var MsgCB: TMessage);
begin
with MsgCB do
case Msg of
WM_MNotifyIcon: WMMNotifyIcon(MsgCB);
else
Result := DefWindowProc(FWnd, Msg, wParam, lParam);
end;
end;
{ TMControlNotifyIcon }
constructor TMControlNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon:=TIcon.Create;
If Assigned(FOnCreate) then
FOnCreate(Self);
end;
destructor TMControlNotifyIcon.Destroy;
begin
If Assigned(FOnDestroy) then
FOnDestroy(Self);
FIcon.Destroy;
inherited Destroy;
end;
procedure TMControlNotifyIcon.SetIcon(const Value: TIcon);
begin
FIcon.Assign(Value);
hIcon:=FIcon.Handle;
end;
procedure TMControlNotifyIcon.ProcIconMessage(var Msg: TMessage);
var
P: TPoint;
Shift: TShiftState;
begin
case Msg.Msg of
WM_QUERYENDSESSION: Msg.Result := 1;
WM_ENDSESSION: HideNotifyIcon;
WM_MNotifyIcon:
begin
Shift := ShiftState();
GetCursorPos(P);
case Msg.LParam of
WM_MOUSEMOVE:
begin
DoMouseMove(Shift,P.X,P.Y);
end;
WM_LBUTTONDOWN:
begin
Include(Shift, ssLeft);
DoMouseDown(mbLeft, Shift, P.X, P.Y);
end;
WM_LBUTTONUP:
begin
Include(Shift, ssLeft);
DoMouseUp(mbLeft, Shift, P.X, P.Y);
end;
WM_LBUTTONDBLCLK:
begin
DoDblClick;
end;
WM_RBUTTONDOWN:
begin
Include(Shift, ssRight);
DoMouseDown(mbRight, Shift, P.X, P.Y);
end;
WM_RBUTTONUP:
begin
Include(Shift, ssRight);
DoMouseUp(mbRight, Shift, P.X, P.Y);
end;
WM_RBUTTONDBLCLK:
begin
DoDbrClick;
end;
WM_MBUTTONDOWN:
begin
Include(Shift, ssMiddle);
DoMouseDown(mbMiddle, Shift, P.X, P.Y);
end;
WM_MBUTTONUP:
begin
Include(Shift, ssMiddle);
DoMouseUp(mbMiddle, Shift, P.X, P.Y);
end;
WM_MBUTTONDBLCLK:
begin
DoDbmClick;
end;
end;
Msg.Result:=1;
end;
end;
end;
procedure TMControlNotifyIcon.Loaded;
begin
inherited;
hIcon:=FIcon.Handle;
end;
procedure TMControlNotifyIcon.SetOnActivate(const Value: TNotifyEvent);
begin
FOnActivate := Value;
end;
procedure TMControlNotifyIcon.SetOnlClick(const Value: TNotifyEvent);
begin
FOnlClick := Value;
end;
procedure TMControlNotifyIcon.SetOnCreate(const Value: TNotifyEvent);
begin
FOnCreate := Value;
end;
procedure TMControlNotifyIcon.SetOnDblClick(const Value: TNotifyEvent);
begin
FOnDblClick := Value;
end;
procedure TMControlNotifyIcon.SetOnDeactivate(const Value: TNotifyEvent);
begin
FOnDeactivate := Value;
end;
procedure TMControlNotifyIcon.SetOnDestroy(const Value: TNotifyEvent);
begin
FOnDestroy := Value;
end;
procedure TMControlNotifyIcon.SetOnMouseDown(const Value: TMouseEvent);
begin
FOnMouseDown := Value;
end;
procedure TMControlNotifyIcon.SetOnMouseEnter(const Value: TMouseMoveEvent);
begin
FOnMouseEnter := Value;
end;
procedure TMControlNotifyIcon.SetOnMouseExit(const Value: TMouseMoveEvent);
begin
FOnMouseExit := Value;
end;
procedure TMControlNotifyIcon.SetOnMouseMove(const Value: TMouseMoveEvent);
begin
FOnMouseMove := Value;
end;
procedure TMControlNotifyIcon.SetOnMouseUp(const Value: TMouseEvent);
begin
FOnMouseUp := Value;
end;
function TMControlNotifyIcon.ShiftState: TShiftState;
begin
Result:=[];
if GetKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;
procedure TMControlNotifyIcon.DolClick;
begin
If Assigned(FOnlClick) then
FOnlClick(Self);
end;
procedure TMControlNotifyIcon.DoDblClick;
begin
If Assigned(FOnDblClick) then
FOnDblClick(Self);
end;
procedure TMControlNotifyIcon.DoMouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Assigned(FOnMouseDown) then
FOnMouseDown(Self,Button,Shift,X,Y);
Case Button of
mbLeft: FlDown:=True;
mbRight: FrDown:=True;
mbMiddle: FmDown:=True;
end;
end;
procedure TMControlNotifyIcon.DoMouseMove(Shift: TShiftState; X, Y: Integer);
begin
If Assigned(FOnMouseMove) then
FOnMouseMove(Self,Shift,X,Y);
end;
procedure TMControlNotifyIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
If Assigned(FOnMouseUp) then
FOnMouseUp(Self,Button,Shift,X,Y);
Case Button of
mbLeft:
begin
if FlDown then DolClick;
FlDown:=False;
end;
mbRight:
begin
if FrDown then DorClick;
FrDown:=False;
end;
mbMiddle:
begin
if FmDown then DomClick;
FmDown:=False;
end;
end;
end;
procedure TMControlNotifyIcon.DoMouseEnter(Shift: TShiftState; X, Y: Integer);
begin
If Assigned(FOnMouseEnter) then
FOnMouseEnter(Self,Shift,X,Y);
end;
procedure TMControlNotifyIcon.DoMouseExit(Shift: TShiftState; X, Y: Integer);
begin
If Assigned(FOnMouseExit) then
FOnMouseExit(Self,Shift,X,Y);
end;
function TMControlNotifyIcon.HideNotifyIcon: Boolean;
begin
Result:= inherited HideNotifyIcon;
If Assigned(FOnDeactivate) then
FOnDeactivate(Self);
end;
function TMControlNotifyIcon.ShowNotifyIcon: Boolean;
begin
Result:= inherited ShowNotifyIcon;
If Assigned(FOnActivate) then
FOnActivate(Self);
end;
function TMControlNotifyIcon.UpdateNotifyIcon: Boolean;
begin
Result:= inherited UpdateNotifyIcon;
If Assigned(FOnUpdateData) then
FOnUpdateData(Self);
end;
procedure TMControlNotifyIcon.SetOnUpdateData(const Value: TNotifyEvent);
begin
FOnUpdateData := Value;
end;
procedure TMControlNotifyIcon.SetOnrClick(const Value: TNotifyEvent);
begin
FOnrClick := Value;
end;
procedure TMControlNotifyIcon.SetOnDbrClick(const Value: TNotifyEvent);
begin
FOnDbrClick := Value;
end;
procedure TMControlNotifyIcon.DoDbrClick;
begin
If Assigned(FOnDbrClick) then
FOnDbrClick(Self);
end;
procedure TMControlNotifyIcon.DorClick;
begin
If Assigned(FOnrClick) then
FOnrClick(Self);
end;
procedure TMControlNotifyIcon.SetOnmClick(const Value: TNotifyEvent);
begin
FOnmClick := Value;
end;
procedure TMControlNotifyIcon.SetOnDbmClick(const Value: TNotifyEvent);
begin
FOnDbmClick := Value;
end;
procedure TMControlNotifyIcon.DoDbmClick;
begin
If Assigned(FOnDbmClick) then
FOnDbmClick(Self);
end;
procedure TMControlNotifyIcon.DomClick;
begin
If Assigned(FOnmClick) then
FOnmClick(Self);
end;
{ TMNotifyIcon }
constructor TMNotifyIcon.Create(AOwner: TComponent);
begin
inherited;
FHookProc:=HookProcess;
end;
destructor TMNotifyIcon.Destroy;
begin
inherited;
end;
procedure TMNotifyIcon.DoDblClick;
begin
inherited;
if FAppHide And (NIAR_DblClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.DoDbmClick;
begin
inherited;
if FAppHide And (NIAR_DbmClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.DoDbrClick;
begin
inherited;
if FAppHide And (NIAR_DbrClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.DolClick;
begin
inherited;
if FAppHide And (NIAR_lClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.DomClick;
begin
inherited;
if FAppHide And (NIAR_mClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
Case Button of
mbLeft:
if NIPM_lUp in FMenuPopupOn then ShowPopMenu(X,Y);
mbRight:
if NIPM_rUp in FMenuPopupOn then ShowPopMenu(X,Y);
mbMiddle:
if NIPM_mUp in FMenuPopupOn then ShowPopMenu(X,Y);
end;
end;
procedure TMNotifyIcon.DorClick;
begin
inherited;
if FAppHide And (NIAR_rClick In Self.FAppRestoreOn) then
RestoreApp;
end;
procedure TMNotifyIcon.HiddApp;
begin
Application.Minimize;
FAppHide := True;
ShowWindow(Application.Handle,SW_HIDE);
end;
function TMNotifyIcon.HideNotifyIcon: Boolean;
begin
Result:= inherited HideNotifyIcon;
Application.UnHookMainWindow(FHookProc);
end;
function TMNotifyIcon.HookProcess(var Message: TMessage): Boolean;
begin
Result:=False;
if Message.Msg = WM_SYSCOMMAND then
begin
Case Message.WParam of
SC_MINIMIZE:
if FHideOnMinimSize then HiddApp;
end
end;
Self.Dispatch(Message);
end;
procedure TMNotifyIcon.Loaded;
begin
if not (csDesigning In Self.ComponentState) then
begin
If Assigned(FIconList) then
begin
if FIconList.Count>0 then
FIconList.GetIcon(FIconIndex,Self.Icon);
end else if Self.Icon.Empty then
begin
If Assigned(Application) then
Self.Icon.Assign(Application.Icon);
end;
end;
inherited Loaded;
end;
procedure TMNotifyIcon.RestoreApp;
begin
Application.Restore;
FAppHide := False;
ShowWindow(Application.Handle,SW_RESTORE);
SetForegroundWindow(Application.Handle);
end;
procedure TMNotifyIcon.SetAppRestoreOn(
const Value: TNotifyIconAppRestoreOns);
begin
FAppRestoreOn := Value;
end;
procedure TMNotifyIcon.SetHideOnMinimSize(const Value: Boolean);
begin
FHideOnMinimSize := Value;
end;
procedure TMNotifyIcon.SetIconIndex(const Value: Integer);
begin
If Assigned(FIconList) then
If (0<=Value) and (Value<=FIconList.Count-1) then
begin
FIconIndex := Value;
end;
end;
procedure TMNotifyIcon.SetIconList(const Value: TImageList);
begin
FIconList := Value;
end;
procedure TMNotifyIcon.SetMenuPopupOn(const Value: TNotifyIconPopMenuOns);
begin
FMenuPopupOn := Value;
end;
procedure TMNotifyIcon.SetPopupMenu(const Value: TPopupMenu);
begin
FPopupMenu := Value;
end;
function TMNotifyIcon.ShowNotifyIcon: Boolean;
begin
Result:= inherited ShowNotifyIcon;
Application.HookMainWindow(FHookProc);
end;
procedure TMNotifyIcon.ShowPopMenu;
begin
if (Screen.ActiveForm <> nil) and (Screen.ActiveForm.Handle <> 0) then
SetForegroundWindow(Screen.ActiveForm.Handle);
If Assigned(PopupMenu) then
begin
PopupMenu.Popup(X,Y);
end;
end;
end.
NotifyIconData;