Hoi allemaal!

Ik heb de laatste versie van FTP van NLDelphi gehaald (NLDTrayIcon051208) en hierin twee fixes aangebracht, zie bovenin de source voor uitleg. (Ze zijn ook toe te passen op de andere versies). Ik heb geen tijd het in het versiebeheer te regelen, maar dat leek me geen reden om degenen die ze zoeken de fixes te onthouden.

Groetjes,

Mark van der Hijden (MarK HendriX)

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.