【delphi开源代码栏目提醒】：网学会员鉴于大家对delphi开源代码十分关注，论文会员在此为大家搜集整理了“FnugryTrayIcon.pas”一文，供大家参考学习

    (*
       fnugrytrayicon.pas
       version 1.0.0.1
    
       TFnugryTrayIcon - a simple tray icon component.
    
       Copyright (C) 1997-98 Gleb Yourchenko
    
       Contact:
       eip__@hotmail.com
       Please include "TFnugryTrayIcon" in the subject string.
    
    *)
    unit FnugryTrayIcon;
    
    interface
    uses
       Windows, ShellAPI, SysUtils, Messages, Classes, Menus, Graphics;
    
    type
    
      ETrayIconError = class(Exception);
    
      TFnugryTrayIcon = class(TComponent)
      private
         FIconData     :TNotifyIconData;
         FHandle       :HWND;
         FRightMenu    :TPopupMenu;
         FLeftMenu     :TPopupMenu;
         FIcon         :TIcon;
         FTip          :String;
         FOnChange     :TNotifyEvent;
         FOnMouseMove  :TNotifyEvent;
         FOnLBtnDown   :TNotifyEvent;
         FOnRBtnDown   :TNotifyEvent;
         FOnLBtnUp     :TNotifyEvent;
         FOnRBtnUp     :TNotifyEvent;
         FOnLBtnDblClk :TNotifyEvent;
         FOnRBtnDblClk :TNotifyEvent;
         procedure SetVisible(Value :Boolean);
         function GetVisible :Boolean;
         procedure SetIcon(Value :TIcon);
         procedure SetTip(const Value :String);
         procedure SetRightMenu(Value :TPopupMenu);
         procedure SetLeftMenu(Value :TPopupMenu);
         procedure AllocateTrayIcon;
         procedure ReleaseTrayIcon;
         procedure UpdateTrayIcon;
         procedure TrayWndProc(var Msg :TMessage);
         procedure evIconChange(Sender :TObject);
      protected
         procedure CheckError(fCond :Boolean; MsgID :Integer);
         procedure MouseMove; virtual;
         procedure MouseLBtnUp; virtual;
         procedure MouseRBtnUp; virtual;
         procedure MouseLBtnDown; virtual;
         procedure MouseRBtnDown; virtual;
         procedure MouseLBtnDblClk; virtual;
         procedure MouseRBtnDblClk; virtual;
         procedure Notification(AComponent: TComponent;
            Operation: TOperation); override;
         procedure Change; virtual;
      public
         constructor Create(AOwner :TComponent); override;
         destructor Destroy; override;
      published
         property Icon :TIcon
            read FIcon write SetIcon;
         property RightMenu :TPopupMenu
            read FRightMenu write SetRightMenu;
         property LeftMenu :TPopupMenu
            read FLeftMenu write SetLeftMenu;
         property Tip :String
            read FTip write SetTip;
         property Visible :Boolean
            read GetVisible write SetVisible;
         property OnChange :TNotifyEvent
            read FOnChange write FOnChange;
         property OnMouseMove  :TNotifyEvent
            read FOnMouseMove write FOnMouseMove;
         property OnMouseLBtnDown   :TNotifyEvent
            read FOnLBtnDown write FOnLBtnDown;
         property OnRBtnDown   :TNotifyEvent
            read FOnRBtnDown write FOnRBtnDown;
         property OnMouseLBtnUp     :TNotifyEvent
            read FOnLBtnUp write FOnLBtnUp;
         property OnMouseRBtnUp     :TNotifyEvent
            read FOnRBtnUp write FOnRBtnUp;
         property OnMouseLBtnDblClk :TNotifyEvent
            read FOnLBtnDblClk write FOnLBtnDblClk;
         property OnMouseRBtnDblClk :TNotifyEvent
            read FOnRBtnDblClk write FOnRBtnDblClk;
      end;
    
    
    
    procedure Register;
    
    implementation
    uses
       forms;
    
    procedure Register;
    begin
       RegisterComponents('Fnugry UI', [TFnugryTrayIcon]);
    end;
    
    {$Resource FnugryTrayIcon.Res}
    {$Include FnugryTrayIcon.Inc}
    
    const
    
      WM_ICONNOTIFY            = WM_USER + $100;
    
    
    procedure TFnugryTrayIcon.SetVisible(Value :Boolean);
    begin
      if Value <> Visible then
         begin
            if Value then
               AllocateTrayIcon
            else
               ReleaseTrayIcon;
            Change;
         end;
    end;
    
    
    function TFnugryTrayIcon.GetVisible :Boolean;
    begin
       result := FHandle <> 0;
    end;
    
    
    procedure TFnugryTrayIcon.SetIcon(Value :TIcon);
    begin
       assert(assigned(FIcon));
       FIcon.Assign(Value);
       if Visible then UpdateTrayIcon;
    end;
    
    
    procedure TFnugryTrayIcon.SetTip(const Value :String);
    begin
       if Value <> FTip then
          begin
             FTip := Value;
             if Visible then UpdateTrayIcon;
             Change;
          end;
    end;
    
    
    procedure TFnugryTrayIcon.SetRightMenu(Value :TPopupMenu);
    begin
       FRightMenu := Value;
    end;
    
    procedure TFnugryTrayIcon.SetLeftMenu(Value :TPopupMenu);
    begin
       FLeftMenu := Value;
    end;
    
    procedure TFnugryTrayIcon.Notification(
       AComponent: TComponent;  Operation: TOperation);
    begin
       if ( Operation = opRemove ) then
          if AComponent = FRightMenu then
             FRightMenu := Nil
          else
             if AComponent = FLeftMenu then
                FLeftMenu := Nil;
    end;
    
    procedure TFnugryTrayIcon.Change;
    begin
       if assigned(FOnChange) then
          FOnChange(Self);
    end;
    
    procedure TFnugryTrayIcon.AllocateTrayIcon;
    begin
      assert(assigned(FIcon));
      if FHandle = 0 then
         begin
            FHandle := AllocateHWnd(TrayWndProc);
            CheckError(FHandle <> 0, msg_err_allocwnd);
            try
               fillchar(FIconData, Sizeof(FIconData), 0);
               FIconData.cbSize := sizeof(FIconData);
               FIconData.uFlags := NIF_ICON OR NIF_MESSAGE OR NIF_TIP;
               FIconData.uCallbackMessage := WM_ICONNOTIFY;
               FIconData.Wnd := FHandle;
               FIconData.hIcon := F