N
NetRobot2001
Unregistered / Unconfirmed
GUEST, unregistred user!
小弟刚开始学写组件,想写一个包装Shell_NotifyIcon的组件。可是这个组件安装以后能够显示图标和提示,可是只要一有回调消息,就抛异常,Access Violation,请高手斧正!
代码:
unit TrayIcon;
interface
uses
Windows, Messages, SysUtils, Classes,Forms,Menus,Shellapi,Graphics,
Controls;
const
CM_TrayIconCallBack = WM_User+1;
IconID = 1001;
type
TTrayIcon = class(TComponent)
{ Private declarations }
private
OwnerHandle:THandle;
FPopupMenu: TPopupMenu;
FIconShowedInTray: TIcon;
N:TNotifyIconData;
FOnMouseLeftDown: TMouseEvent;
FOnMouseRightDown: TMouseEvent;
FOnMouseRightup: TMouseEvent;
FOnMouseleftup: TMouseEvent;
FHandle: HWND;
FHint: String;
FOnMouseLeftDblClick: TMouseEvent;
FOnMouseRightDblClick: TMouseEvent;
procedure SetPopupMenu(const Value: TPopupMenu);
procedure SetIconShowedInTray(const Value: TIcon);
procedure SetHint(const Value: String);
procedure CMTrayIconCallBack(var M: TMessage);message CM_TrayIconCallBack;
function GetShiftState:TShiftState;
protected
{ Protected declarations }
public
{ Public declarations }
procedure MenuPopup;
procedure ShowIconInTray;
procedure DeleteIconInTray;
procedure ChangeIconInTray(NewIcon:TIcon);
procedure ChangeTrayTips(Tips:String);
published
{ Published declarations }
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
property PopupMenu:TPopupMenu read FPopupMenu write SetPopupMenu;
property IconShowedInTray:TIcon read FIconShowedInTray write SetIconShowedInTray;
property OnMouseLeftDown:TMouseEvent read FOnMouseLeftDown write FOnMouseLeftDown;
property OnMouseRightDown:TMouseEvent read FOnMouseRightDown write FOnMouseRightDown;
property OnMouseleftup:TMouseEvent read FOnMouseleftup write FOnMouseleftup;
property OnMouseRightup:TMouseEvent read FOnMouseRightup write FOnMouseRightup;
property OnMouseLeftDblClick:TMouseEvent read FOnMouseLeftDblClick write FOnMouseLeftDblClick;
property OnMouseRightDblClick:TMouseEvent read FOnMouseRightDblClick write FOnMouseRightDblClick;
property Handle:HWND read FHandle;
property Hint:String read FHint write SetHint;
//property Handle;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyComponents', [TTrayIcon]);
end;
{ TTrayIcon }
{ TTrayIcon }
procedure TTrayIcon.ChangeIconInTray(NewIcon:TIcon);
begin
IconShowedInTray := NewIcon;
N.hIcon := IconShowedInTray.Handle;
Shell_NotifyIcon(NIM_MODIFY,@N)
end;
procedure TTrayIcon.ChangeTrayTips(Tips: String);
begin
StrLCopy(@N.szTip,Pchar(Tips),sizeof(N)-1);
Shell_NotifyIcon(NIM_MODIFY,@N);
end;
procedure TTrayIcon.CMTrayIconCallBack(var M: TMessage);
var
P:TPoint;
begin
//MessageBox(self.OwnerHandle,'back','****',MB_OK );
if ( M.Msg = CM_TrayIconCallBack ) then
begin
GetCursorPos(P);
try
case M.LParam of
WM_LBUTTONDOWN : FOnMouseLeftDown(self,mbLeft,GetShiftState,P.X,p.Y);
WM_LBUTTONUP : FOnMouseLeftDown(self,mbRight,GetShiftState,p.X,p.Y);
WM_RBUTTONDOWN : FOnMouseRightDown(self,mbRight,GetShiftState,p.X,p.Y);
WM_RBUTTONUP : FOnMouseleftup(self,mbRight,GetShiftState,p.X,p.Y);
WM_LBUTTONDBLCLK : FOnMouseLeftDblClick(self,mbLeft,GetShiftState,p.X,p.Y);
WM_RBUTTONDBLCLK : FOnMouseRightDblClick(self,mbRight,GetShiftState,p.X,p.Y);
end;
except
Application.HandleException(self);
end;
end;
//DefWindowProc(FHandle,M.Msg,M.WParam,M.LParam);
end;
constructor TTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if (AOwner is TForm) then
OwnerHandle:=TForm(AOwner).Handle;
FIconShowedInTray := TIcon.Create;
FHandle:=Forms.AllocateHWnd(CMTrayIconCallBack)
//FPopupMenu := TPopupMenu.Create(self);
end;
procedure TTrayIcon.DeleteIconInTray;
begin
Shell_NotifyIcon(NIM_DELETE,@N);
end;
destructor TTrayIcon.Destroy;
begin
//free the instance created by the constructor here
FIconShowedInTray.Free;
Forms.DeallocateHWnd(FHandle);
//FPopupMenu.Free;
inherited Destroy;
end;
function TTrayIcon.GetShiftState: TShiftState;
begin
Result:=[];
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;
procedure TTrayIcon.MenuPopup;
var
P:TPoint;
begin
GetCursorPos(P);
PopupMenu.Popup(p.X,p.Y);
end;
procedure TTrayIcon.SetHint(const Value: String);
begin
FHint := Value;
end;
procedure TTrayIcon.SetIconShowedInTray(const Value: TIcon);
begin
FIconShowedInTray.Assign(Value);
end;
procedure TTrayIcon.SetPopupMenu(const Value: TPopupMenu);
begin
FPopupMenu:=Value;
end;
procedure TTrayIcon.ShowIconInTray;
begin
N.cbSize := sizeof(N);
N.Wnd := self.Handle;
N.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
N.hIcon := self.FIconShowedInTray.Handle;
StrLCopy(@N.szTip,Pchar(FHint),63);
//MessageBox(Self.Handle,N.szTip,'ok',MB_OK);
N.uCallbackMessage := CM_TrayIconCallBack;
N.uID := IconID;
Shell_NotifyIcon(NIM_ADD,@N);
end;
end.