Code:
unit NLDTrayIcon;
{
Versie 1.2
This component is made by Stijn van Grinsven,
A Member of NLDelphi.
* The TNLDTrayIcon supports the Crash-message wich is send
by windows after a crash
20051213 MvdH (Mark HendriX) - NLDTrayIcon051208 as basis, changes marked 20051213
fixed: Windows log-off/shutdown fails due to NLTrayIcon
fixed: Access Violation if MainForm is nil
20031709 Changes by PsychoMark (www.x2software.net)
Added: ImageIndex property. Enables the use of the ImageList even if
AnimateEnabled is False.
20031408 Changes by Remmelt Koenes (www.triplesoftware.com)
Added: ShowBalloon now is a function and will return a boolean on
sucsesful creating a balloonHint.
Added: HideBalloon is a function that will hide the balloonhint by
by code. It will fire the OnBalloonHide event and will return
a boolean on sucsesful hidding a balloonHint.
Fixed: OnBalloonHide.
Changed: The Balloon hint is now a unit global variable.
20031408 Changes by PsychoMark (www.x2software.net)
Fixed: WM_TASKBAR_CREATED was using a hardcoded value (baaaaaad bug),
now uses RegisterWindowMessage to check for the correct value.
20030808 Changes by PsychoMark (www.x2software.net)
Added: RestoreApp function which restores the tray-minimized application,
also called if ComeToFront is set to True. Application.Restore was
already available, but this function enables future additions if
necessary without breaking any code.
20030708 Changes by PsychoMark (www.x2software.net)
Added: reference to NLDTrayIcon.DCR for component icon
Fixed: (De)AllocateHwnd now uses the Classes version if using D6 or higher
(also requires CompilerVersion.inc to determine D6 now), eliminates
the deprecated warnings.
Fixed: SetIcon and FOnBalloonHide were not used but not commented out
either, caused warnings/hints.
Fixed: Moved component to NLDelphi tab instead of SVG tab to conform to
the NLDelphi Open-Source component standards.
Fixed: Changed the package description to just 'NLDTrayIcon', makes it
MUCH easier to search for it in the Component -> Install Packages list
Fixed: Removed dependancy on Dialogs and Math, don't seem to be necessary.
Haven't tested this in D5 and below, so I'm sorry if it breaks
any code on those version.
20020410 Changes by Remmelt Koenes (www.triplesoftware.com)
AddFeature: Ballon Functions
Balloon Click
Balloon Show
Balloon Hide This one does not work some how
Balloon TimeOut
20021227 Added feature: Animation in Tray
property AutoSwitch = Boolean
. when True, it will animate the icon in the tray
property AutoDelat = DWord
. the interval between every icon-switch
property ImageList = TImageList
. the list of images where the icons for animation is stored
property AnimateIndex = Word
. The icon currently showing
20020919#2 changed by MendriX ICT (www.mendrix.nl) (quoted with '//MendriX >>> #2' tags)
TTrayIcon is now made compatible with the use of:
. Application.ShowMainForm := False; with SomeMainForm.Visible := False, which
is considered as being minimized
. from now on a short-cuts Minimized/Normal/Maximized setting is also respected
20020919 added by MendriX ICT (www.mendrix.nl):
public
property MainFormOverruled
. overrules Application.MainForm at any time,
for behaviour as 'Close means terminate' and 'minimize means app. minimizes'
published
property LocationMinimized = [loSysTray,loTaskBar]
. determines where minimized application is shown:
taskbar and/or systray
property LocationNormal = [loSysTray,loTaskBar]
. determines where normal application is shown:
taskbar and/or systray
20020919 some efficiency improvements, cause before some methods were called multiple times
}
interface
uses
Windows, Messages, SysUtils, Classes, menus, ShellApi, Forms, Graphics, ExtCtrls,
AppEvnts, Controls, ImgList, CommCtrl;
Const
WM_TRAYICON = WM_USER + 1;
WM_TRAYICON_UPDATE = WM_USER + 2;
{Rckoenes >>>}
// Balloon stuf
WM_BALLOONSHOW = WM_USER + 2;
WM_BALLOONHIDE = WM_USER + 3; // Zou moeten werk maar doet het niet :(
WM_BALLOONTIMEOUT = WM_USER + 4;
WM_BALLOONCLICK = WM_USER + 5;
{<<< Rckoenes}
WM_BALLOONMSG = WM_USER + 3;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;
{PsychoMark >>>}
var
WM_TASKBAR_CREATED: Cardinal;
{<<< PsychoMark}
type
TpopUpNotify = Procedure ( Sender: Tpopupmenu; Var DopopUp: Boolean ) of object;
pIcon = ^TIcon;
{ For TIP}
TNotifyIconData_TipInfo = record // defined in shellapi.h
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..MAXCHAR] of AnsiChar;
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..MAXBYTE] of AnsiChar;
uTimeout: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end;
TTimeout = 10..30{seconds};
TIconType = (bitNone, // no icon
bitInfo, // Icon: information
bitWarning, // icon: Warning
bitError); // icon: Error
{ /For TIP}
TApplicationLocations = set of (loTaskBar,loSysTray);
TNLDTrayIcon = class(TComponent)
private
MNic:TNotifyIconData;
Icon: TIcon;
Wnd: Thandle;
{rckoenes >>}
FBalloonTip: TNotifyIconData_TipInfo;
{<< rckoenes}
FActive: Boolean;
FHint: String;
FShowHint: Boolean;
FComeToFront: Boolean;
Fpopup: Boolean;
FPopUpMenu: Tpopupmenu;
FOnPopUp: TnotifyEvent;
FOnDblClick: TNotifyEvent;
FOnRmouseClick: TPopUpNotify;
FOnClick: TnotifyEvent;
FFilename: TFileName;
FFirstRestoreOrMinimize: Boolean;
FHiddenOnTaskBar : Boolean;
FApplicationEvents : TApplicationEvents;
FLocationNormal: TApplicationLocations;
FLocationMinimized: TApplicationLocations;
FImageList: TImageList;
FAnimateEnabled: Boolean;
FAnimateInterval: DWord;
FInternTimer: TTimer;
FAnimateIndex: Word;
{PsychoMark >>>}
FImageIndex: TImageIndex;
{<<< PsychoMark}
{Rckoenes >>>}
FOnBalloonClick : TnotifyEvent;
FOnBalloonShow : TnotifyEvent;
{PsychoMark >>>}
FOnBalloonHide : TnotifyEvent;
{<<< PsychoMark}
FOnBalloonTimeout : TnotifyEvent;
{<<< Rckoenes}
Procedure DoOnTimer( Sender: TObject );
procedure SetActive(const Value: Boolean);
Procedure MakeInTray( Flag: byte );
procedure MakeOnTaskBar;
Procedure CaptureMSG( Var MSG: Tmessage ); message WM_TRAYICON;
procedure Minimize;
procedure Restore;
procedure SetMainFormOverruled(const Value: TCustomForm);
procedure ApplicationMinimizeHandler(Sender: TObject);
procedure ApplicationRestoreHandler(Sender: TObject);
function ShouldShowInTray: Boolean;
function ShouldShowOnTaskBar: Boolean;
function GetMainFormOverruled: TCustomForm;
Procedure SetLocationMinimized(const Value: TApplicationLocations);
Procedure SetLocationNormal(const Value: TApplicationLocations);
Procedure SetAnimateIndex( Const Value: Word );
Procedure SetAnimateInterval( Const Value: DWord );
procedure SetAnimateEnabled(const Value: Boolean);
Procedure SetHint( Const Value: String );
{PsychoMark >>>}
procedure SetImageIndex(const Value: TImageIndex);
//Procedure SetIcon( IconHandle: THandle );
{<<< PsychoMark}
protected
{ Protected declarations }
public
constructor Create(Aowner: TComponent); Override;
Destructor Destroy; Override;
Procedure Update;
Function PopBalloon( Const BalloonText, BalloonTitle: String;
Const IconID: TIconType;
Const TimeOut: integer = 3): Boolean;
Function HideBalloon : Boolean;
property MainFormOverruled: TCustomForm read GetMainFormOverruled write SetMainFormOverruled;
{PsychoMark >>>}
procedure RestoreApp();
{<<< PsychoMark}
published
{ Property's }
Property Active: Boolean read FActive write SetActive default false;
Property Hint: String read FHint write SetHint;
Property ShowHint: Boolean read FShowHint write FShowHint;
Property PopUpMenu: Tpopupmenu read FPopUpMenu write FPopUpMenu;
Property Popup: Boolean read Fpopup write FPopup;
Property ComeToFront: Boolean read FComeToFront write FComeToFront;
property LocationMinimized: TApplicationLocations read FLocationMinimized write SetLocationMinimized;
property LocationNormal : TApplicationLocations read FLocationNormal write SetLocationNormal;
Property Filename: TFileName read FFilename write FFilename;
//---
Property ImageList: TImageList read FImageList write FImageList;
Property AnimateEnabled: Boolean read FAnimateEnabled write SetAnimateEnabled;
Property AnimateInterval: DWord read FAnimateInterval write SetAnimateInterval default 1000;
Property AnimateIndex: Word read FAnimateIndex write SetAnimateIndex;
{PsychoMark >>>}
Property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
{<<< PsychoMark}
{ Events }
Property OnPopUp: TnotifyEvent read FOnPopUp write FOnPopUp;
Property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
Property OnRmouseClick: TpopUpNotify read FOnRmouseClick write FOnRmouseClick;
Property OnClick: TnotifyEvent read FOnClick write FOnClick;
{Rckoenes >>>}
Property OnBalloonClick: TnotifyEvent read FOnBalloonClick write FOnBalloonClick;
Property OnBalloonShow: TnotifyEvent read FOnBalloonShow write FOnBalloonShow;
Property OnBalloonHide: TnotifyEvent read FOnBalloonHide write FOnBalloonHide;
Property OnBalloonTimeOut: TnotifyEvent read FOnBalloonTimeOut write FOnBalloonTimeOut;
{<<< Rckoenes}
end;
procedure Register;
implementation
{PsychoMark >>>}
{$R *.DCR}
{$I CompilerVersion.inc}
{<<< PsychoMark}
procedure Register;
begin
{PsychoMark >>>}
RegisterComponents('NLDelphi', [TNLDTrayIcon]);
{<<< PsychoMark}
end;
{ TNLDTrayIcon }
Procedure TNLDTrayIcon.ApplicationMinimizeHandler(Sender: TObject);
begin
MakeInTray(0);
MakeOnTaskBar;
end;
procedure TNLDTrayIcon.ApplicationRestoreHandler(Sender: TObject);
begin
MakeInTray(0);
MakeOnTaskBar;
end;
procedure TNLDTrayIcon.CaptureMSG(var MSG: Tmessage);
Var
P: Tpoint;
Dopop: Boolean;
begin
//WM_TRAYICON_UPDATE?
if MSG.Msg = WM_TRAYICON_UPDATE then begin
MakeInTray(0);
MakeOnTaskBar;
//WM_TRAYICON?
end else if MSG.Msg = WM_TRAYICON then begin
//WM_LBUTTONDBLCLK
case Msg.LParam of
WM_LBUTTONDBLCLK: begin
If FComeToFront then
{PsychoMark >>>}
RestoreApp();
{<<< PsychoMark}
if assigned(FonDBLclick) then FonDBLclick(Self);
end;
WM_LBUTTONDOWN: if assigned(Fonclick) then Fonclick(Self);
WM_RBUTTONDOWN: if FPopupmenu <> NIL then
begin
DoPop := True;
If assigned( FonRmouseClick ) then
FonRMouseClick( FpopUpMenu, Dopop );
If Dopop then
begin
Getcursorpos(P);
If Fpopup then
begin
If Assigned( FonPopUp ) then
FonPopUp( FpopUpMenu );
Fpopupmenu.Popup(p.x, P.y);
end;
end;
end;
{Rckoenes >>>}
WM_BALLOONSHOW : if assigned(FOnBalloonShow) then FOnBalloonShow(Self);
WM_BALLOONHIDE : if assigned(FOnBalloonHide) then FOnBalloonHide(Self);
WM_BALLOONTIMEOUT : if assigned(FOnBalloonTimeout) then FOnBalloonTimeout(Self);
WM_BALLOONCLICK : if assigned(FOnBalloonClick) then FOnBalloonClick(Self);
{<<< Rckoenes}
//case Msg.LParam of
end
//all other messages
end else begin
//WM_TASKBAR_CREATED?
If MSG.Msg = WM_TASKBAR_CREATED then
MakeInTray( 0 )
//WM_ACTIVATEAPP?
else If (MSG.Msg = WM_ACTIVATEAPP) and (MSG.LParam = 1576) then
{PsychoMark >>>}
RestoreApp()
{<<< PsychoMark}
//20051213 MvdH (MarK HendriX) - process all 'left-overs'
else
MSG.Result := DefWindowProc(Wnd, MSG.Msg, MSG.WParam, MSG.LParam)
end
end;
constructor TNLDTrayIcon.Create;
begin
inherited;
{PsychoMark >>>}
Wnd := {$IFDEF D6}Classes.{$ENDIF}AllocateHwnd(CaptureMSG);
FImageIndex := -1;
{<<< PsychoMark}
PostMessage(Wnd,WM_TRAYICON_UPDATE,0,0);
FFirstRestoreOrMinimize := False;
FLocationNormal := [loTaskBar,loSysTray];
FLocationMinimized := [loTaskBar,loSysTray];
FHiddenOnTaskBar := False;
FApplicationEvents := TApplicationEvents.Create(Self);
FApplicationEvents.OnMinimize := ApplicationMinimizeHandler;
FApplicationEvents.OnRestore := ApplicationRestoreHandler;
FAnimateIndex := 1;
FInternTimer := TTimer.Create(Self);
FInternTimer.OnTimer := DoOnTimer;
Icon := TIcon.Create;
end;
destructor TNLDTrayIcon.Destroy;
begin
Try
If Wnd <> 0 then
{PsychoMark >>>}
{$IFDEF D6}Classes.{$ENDIF}DeallocateHwnd(Wnd);
{<<< PsychoMark}
If Assigned(Icon) then
FreeAndNIL(Icon);
If Assigned( FInternTimer ) then
FreeAndNIL( FInternTimer );
Inherited;
Finally
Shell_NotifyIcon(NIM_DELETE, @mnic);
End;
end;
function TNLDTrayIcon.ShouldShowInTray: Boolean;
begin
if not Active then
Result := False
else
if IsIconic(Application.Handle) then
Result := ( loSysTray in LocationMinimized )
else
Result := ( loSysTray in LocationNormal )
end;
function TNLDTrayIcon.ShouldShowOnTaskBar: Boolean;
begin
if not Active then
Result := True
else
if IsIconic(Application.Handle) then begin//truely minimized
Result := ( loTaskBar in LocationMinimized )
end else begin //not truely minimized
Result := ( loTaskBar in LocationNormal )
end;
end;
procedure TNLDTrayIcon.MakeInTray( Flag: byte );
begin
if ( [csDesigning,csLoading]*ComponentState )<>[] then
Exit;
If FActive and ShouldShowInTray then
begin
With Mnic do
begin
cbSize := SizeOf(TNotifyIconData);
wnd := Self.Wnd;
uid := 1;
uCallBackMessage := WM_TrayIcon;
If Fileexists(FFilename) then
begin
Icon.LoadFromFile( FFilename );
hIcon := Icon.Handle;
{PsychoMark >>>}
end else if (Assigned(FImageList)) and (FImageIndex > -1) then begin
hIcon := ImageList_GetIcon(FImageList.Handle, FImageIndex, 0);
{<<< PsychoMark}
end else
hIcon := Application.Icon.Handle;
uFlags := nif_message or NIF_ICON;
If FShowHint then
begin
uFlags := uFlags or Nif_tip;
FillChar( szTip, Length( szTip ), 0 );
StrPCopy(szTip, Fhint);
end;
end;
If Flag = 0 then
Shell_NotifyIcon(NIM_ADD, @mnic) else
Shell_NotifyIcon(NIM_MODIFY, @mnic);
end else
Shell_NotifyIcon(NIM_DELETE, @mnic);
end;
Function TNLDTrayIcon.PopBalloon(const BalloonText, BalloonTitle: String;
const IconID: TIconType; const TimeOut: integer = 3) : boolean;
const
aBalloonIconTypes : array[TIconType] of Byte =
(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
{ rckoenes >>
var
NID : TNotifyIconData_TipInfo;
<< rckoenes }
begin
FillChar({NID} FBalloonTip, SizeOf(TNotifyIconData_TipInfo), 0);
with FBalloonTip do begin
cbSize := SizeOf(TNotifyIconData_TipInfo);
Wnd := Self.Wnd;
uID := 1;
uFlags := NIF_INFO;
StrPCopy(szInfo, BalloonText);
uTimeout := Timeout * 1000;
StrPCopy(szInfoTitle, BalloonTitle);
uCallbackMessage := WM_TRAYICON;
dwInfoFlags := aBalloonIconTypes[IconId];
end{with};
result := Shell_NotifyIcon(NIM_modify, @FBalloonTip);
end;
procedure TNLDTrayIcon.SetActive(const Value: Boolean);
begin
FActive := Value;
MakeInTray(0);
MakeOnTaskBar;
FInternTimer.Enabled := FActive And FAnimateEnabled;
end;
procedure TNLDTrayIcon.Update;
begin
MakeInTray(1);
MakeOnTaskBar;
end;
procedure TNLDTrayIcon.Minimize;
begin
if not Active then
Exit;
if ShouldShowOnTaskBar then begin
ShowWindow(Application.Handle,SW_SHOW)
end else
ShowWindow(Application.Handle,SW_HIDE);
end;
procedure TNLDTrayIcon.Restore;
begin
if not Active then
Exit;
//
SetForegroundWindow(Application.Handle); //otherwise sometimes all in the back
ShowWindow(Application.Handle,SW_RESTORE); //redundant?
repeat
if Assigned(Application.MainForm) then //show mainform
if not FFirstRestoreOrMinimize then begin
if not Application.ShowMainForm
or ( Application.MainForm.WindowState = wsMinimized )
or not Application.MainForm.Visible then begin
Application.Minimize;
Break;
end;
//20051213 MvdH (Mark HendriX): next was outside following end;, which could cause AV's
Application.MainForm.Show;
end;
until True;
if not ShouldShowOnTaskBar then //hide on taskbar if needed
ShowWindow(Application.Handle,SW_HIDE);
end;
procedure TNLDTrayIcon.MakeOnTaskBar;
begin
if ([csDesigning,csLoading]*ComponentState)<>[] then
Exit;
if IsIconic(Application.Handle) then
Minimize
else
Restore;
FFirstRestoreOrMinimize := True;
end;
procedure TNLDTrayIcon.SetMainFormOverruled(const Value: TCustomForm);
begin
Pointer(Pointer(@Application.Mainform)^) := Value;
end;
function TNLDTrayIcon.GetMainFormOverruled: TCustomForm;
begin
Result := Application.MainForm;
end;
procedure TNLDTrayIcon.SetLocationMinimized(
const Value: TApplicationLocations);
begin
if ( ( Value*[loTaskBar] ) = ( LocationMinimized*[loTaskBar] ) )
and ( ( Value*[loSysTray] ) = ( LocationMinimized*[loSysTray] ) ) then
Exit;
//
FLocationMinimized := Value;
MakeInTray(0);
MakeOnTaskBar;
end;
procedure TNLDTrayIcon.SetLocationNormal(
const Value: TApplicationLocations);
begin
if ( ( Value*[loTaskBar] ) = ( LocationNormal*[loTaskBar] ) )
and ( ( Value*[loSysTray] ) = ( LocationNormal*[loSysTray] ) ) then
Exit;
//
FLocationNormal := Value;
//
MakeInTray(0);
MakeOnTaskBar;
end;
procedure TNLDTrayIcon.DoOnTimer(Sender: TObject);
Var
Icon: TIcon;
begin
If not Assigned( ImageList ) then
Exit;
If FAnimateIndex > ImageList.Count - 1 then
FAnimateIndex := 0;
Icon := TIcon.Create;
ImageList.GetIcon( FAnimateIndex, Icon );
With Mnic do
Hicon := Icon.Handle;
Shell_NotifyIcon(NIM_MODIFY, @mnic);
Icon.Free;
Inc( FAnimateIndex, 1 );
end;
procedure TNLDTrayIcon.SetAnimateIndex(const Value: Word);
begin
FAnimateIndex := Value;
if ( [csDesigning,csLoading]*ComponentState )<>[] then
Exit;
DoOnTimer( NIL );
end;
procedure TNLDTrayIcon.SetAnimateInterval(const Value: DWord);
begin
FAnimateInterval := Value;
FInternTimer.Interval := Value;
end;
procedure TNLDTrayIcon.SetAnimateEnabled(const Value: Boolean);
begin
FAnimateEnabled := Value;
FInternTimer.Enabled := FActive And FAnimateEnabled;
If not FAnimateEnabled then
With Mnic do
Begin
If FileExists( FFilename ) then
begin
Icon.LoadFromFile( FFilename );
Hicon := Icon.Handle;
end else
Hicon := Application.Icon.Handle;
End;
Shell_NotifyIcon(NIM_MODIFY, @mnic);
end;
procedure TNLDTrayIcon.SetHint(const Value: String);
begin
FHint := Value;
With Mnic do
begin
FillChar( szTip, Length( szTip ), 0 );
StrPCopy( szTip, Value );
end;
Shell_NotifyIcon( NIM_MODIFY, @mnic );
end;
{PsychoMark >>>}
{
procedure TNLDTrayIcon.SetIcon( IconHandle: THandle );
begin
With Mnic do
hIcon := IconHandle;
Shell_NotifyIcon( NIM_MODIFY, @mnic );
end;
}
procedure TNLDTrayIcon.RestoreApp();
begin
Application.Restore;
end;
function TNLDTrayIcon.HideBalloon : Boolean;
begin
with FBalloonTip do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end;
result := Shell_NotifyIcon(NIM_modify, @FBalloonTip)
end;
procedure TNLDTrayIcon.SetImageIndex;
begin
FImageIndex := Value;
MakeInTray(1);
end;
initialization
WM_TASKBAR_CREATED := RegisterWindowMessage('TaskbarCreated');
{<<< PsychoMark}
end.
Bookmarks