请高手斧正源代码!(100分)

  • 主题发起人 主题发起人 NetRobot2001
  • 开始时间 开始时间
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.
 
我想是不是这
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;

在调用事件前,加一个判断 if assigned(fonmouserightdown) then OnMouseRightDown(self,mbRight,GetShiftState,p.X,p.Y);
 
agree with Brave
 
我原来也想到这一点了,但不知道Assigned函数,用了 if (FOnMouseLeftClick <> nil )
then ....
不知道为什么不行?
我想FOnMouseLeftClick既然是一个指针,为什么不能用<>nil?谢谢!
 
我觉得应该可以,你还是先试验一下,看看问题解决了吗?
再找原因
 
谢谢大家!
 

Similar threads

I
回复
0
查看
508
import
I
I
回复
0
查看
527
import
I
I
回复
0
查看
541
import
I
I
回复
0
查看
625
import
I
后退
顶部