Jeg har været ved at kigge i mine gemmer. og har fundet et komponent jeg skrev sidste vinter. Det løser nemt og enkelt problemet omkring menu og icon add og remove og saget. Det hele er pakket ind i events.
Kopier det følgende kode.
Gem det i en fil der hedder SysTray.pas
og instaler DEN fil som et komponent. Den smækker du så bare på den form og bruger ....
unit SysTray;
// Implements the TSysTrayIcon component, which controls an icon in
// the system tray
// Feel free to modify and use this code.
// The only thing I ask, is that you leave my name in the source file.
// Please note that I provide this code as an example, and I
// make no warranties whatsoever on the results of using this code.
// Meaning: Whatever happens because you\'ve used this code, is your own
// responsibility.
// Also note that I have NOT tested this code very thoroughly, I just
// wrote it in response to several newsgroup messages requesting information
// on how to implement SysTray icons.
// Thule Air Base, Greenland, May 30. 2000
// Jens Borrisholt
interface
uses
Classes, Forms, SysUtils, Graphics, ShellAPI, Windows, Messages;
const
// Callback message, change to anything above WM_USER that don\'t
// conflict with Delphi-defined msgs
PM_ICONCALLBACK = WM_USER+0005;
type
TSysTrayIcon = class;
TSysTrayIconEvent = procedure(Sender : TSysTrayIcon; X, Y : Word) of object;
TSysTrayIcon = class (TComponent)
private
protected
FOnLeftClick,
FOnLeftDblClick,
FOnRightClick,
FOnRightDblClick,
FOnMouseMove : TSysTrayIconEvent;
FIcon : TIcon;
FHandle : HWND;
FVisible : Boolean;
FIconID : Integer;
FToolTip : String;
// Message handler
procedure WndProc (var message : TMessage);
// Property implementation
procedure SetVisible (value : Boolean);
procedure SetToolTip (value : String);
procedure SetIcon (value : TIcon);
// Misc. methods
procedure IconChanged;
procedure SetIconData (var IconData : TNotifyIconData);
public
// New constructor and destructor
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
published
// Misc properties
property Icon : TIcon read FIcon write SetIcon;
property ToolTip : String read FToolTip write SetToolTip;
property Visible : Boolean read FVisible write SetVisible;
// Misc events
property OnLeftClick : TSysTrayIconEvent read FOnLeftClick write FOnLeftCLick;
property OnLeftDblClick : TSysTrayIconEvent read FOnLeftDblClick write FOnLeftDblClick;
property OnRightClick : TSysTrayIconEvent read FOnRightClick write FOnRightCLick;
property OnRightDblClick : TSysTrayIconEvent read FOnRightDblClick write FOnRightDblCLick;
property OnMouseMove : TSysTrayIconEvent read FOnMouseMove write FOnMouseMove;
end;
procedure Register;
implementation
const
// Used to ensure that each added icon has an unique ID
IconIndex : LONGINT = 0;
procedure Register;
begin
RegisterComponents(\'Samples\', [TSysTrayIcon]);
end;
constructor TSysTrayIcon.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
FHandle := AllocateHWND(WndProc); // Allocate a window handle for callback messages
FIcon := TIcon.Create; // Create the icon, and set default
FIcon.Handle := Application.Icon.Handle;
FIconID := IconIndex; // Set the internal icon id.
inc(IconIndex);// And increment the instance count, to allow multiple systray icons
end;
destructor TSysTrayIcon.Destroy;
begin
Visible := FALSE; // Make sure the icon is removed
DeallocateHWND(FHandle); // Deallocate the window handle
FIcon.Free; // And free the icon object
end;
procedure TSysTrayIcon.SetIconData(var IconData:TNotifyIconData);
begin
// Set the standard size of structure field
IconData.cbSize := SizeOf(IconData);
// Window to receive callback messages
IconData.Wnd := FHandle;
// Internal ID of the icon
IconData.uID := FIconID;
// Message we want to receive when something happens to the icon
IconData.uCallbackMessage := PM_ICONCALLBACK;
// Handle to the icon.
IconData.hIcon := FIcon.Handle;
// The tooltip
StrPCopy(IconData.szTip, FToolTip);
// IconData contains a valid window handle, a valid icon handle, and a valid
// tooltip
IconData.uFlags := NIF_MESSAGE + NIF_TIP + NIF_ICON;
end;
procedure TSysTrayIcon.IconChanged;
var
IconData : TNotifyIconData;
begin
// No need to do anything, if the icon ain\'t visible
if not Visible then
exit;
// Set the IconData fields
SetIconData(IconData);
// And tell systray the icon\'s changed
Shell_NotifyIcon(NIM_MODIFY, ADDR(IconData));
end;
procedure TSysTrayIcon.SetIcon (value : TIcon);
begin
// Copy the passed icon.
FIcon.Assign(value);
// Update the icon (if visible)
IconChanged;
end;
procedure TSysTrayIcon.SetVisible (value : Boolean);
var
IconData : TNotifyIconData;
begin
if value=FVisible then
exit;
// We don\'t want systray icons while designing the form. This check
// could be removed, but then two icons would be visible when running
// the app from the Delphi IDE
if not (csDesigning in ComponentState) then
begin
// Set the icondata fields
SetIconData(IconData);
// Add or remove the icon
if value then
FVisible := Shell_NotifyIcon(NIM_ADD, ADDR(IconData))
else
FVisible := not Shell_NotifyIcon(NIM_DELETE, ADDR(IconData));
end
else
FVisible := value;
end;
procedure TSysTrayIcon.SetToolTip (value : String);
begin
if FToolTip=value then
exit;
// Set the new tooltip
FToolTip := value;
// Update the icon (if visible)
IconChanged;
end;
procedure TSysTrayIcon.WndProc (var message : TMessage);
var
pt : TPoint;
begin
// Could also include ButtonUp messages
// Should use GetMessagePos, but ain\'t always working correctly.
if message.msg = PM_ICONCALLBACK then
begin
// lParam contains the actual message.
case message.lParam of
WM_LBUTTONDOWN:
if Assigned (FOnLeftClick) then
begin
GetCursorPos (pt);
FOnLeftClick(Self, pt.X, pt.Y);
end;
WM_LBUTTONDBLCLK:
if Assigned (FOnLeftDblClick) then
begin
GetCursorPos (pt);
FOnLeftDblClick(Self, pt.X, pt.Y);
end;
WM_RBUTTONDOWN:
if Assigned (FOnRightClick) then
begin
GetCursorPos (pt);
FOnRightClick(Self, pt.X, pt.Y);
end;
WM_RBUTTONDBLCLK:
if Assigned (FOnRightDblClick) then
begin
GetCursorPos (pt);
FOnRightDblClick(Self, pt.X, pt.Y);
end;
WM_MOUSEMOVE :
if Assigned (FOnMouseMove) then
begin
GetCursorPos (pt);
FOnMouseMove(Self, pt.X, pt.Y);
end;
end;
end;
end;
initialization
end.
Jens B
http://fotx.net/borrisholt
