home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d56 / TDSOFT.ZIP / TDTrayIcon.pas < prev   
Pascal/Delphi Source File  |  2001-08-09  |  5KB  |  182 lines
  1. unit TDTrayIcon;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  7.  
  8. const
  9.   WM_MYTRAYICON=WM_USER + 1;
  10.  
  11. type
  12.   NOTIFYICONDATA=record
  13.     cbSize: DWORD;
  14.     HWND: hWnd;
  15.     uID: UINT;
  16.     uFlags: UINT;
  17.     uCallbackMessage :UINT;
  18.     hIcon: HICON ;
  19.     szTip: String[64];
  20.   end;
  21.  
  22.   TTDTrayIcon = class(TComponent)
  23.   private
  24.     FActive: Boolean;
  25.     FIcon: TIcon;
  26.     FHint: String;
  27.     FOnLeftUp: TNotifyEvent;
  28.     FOnCenterUp: TNotifyEvent;
  29.     FOnRightDown: TNotifyEvent;
  30.     FOnDblClickRight: TNotifyEvent;
  31.     FOnLeftDown: TNotifyEvent;
  32.     FOnDblClickCenter: TNotifyEvent;
  33.     FOnRightUp: TNotifyEvent;
  34.     FOnCenterDown: TNotifyEvent;
  35.     FOnDblClickLeft: TNotifyEvent;
  36.     procedure SetActive(const Value: Boolean);
  37.     procedure SetIcon(const Value: TIcon);
  38.     procedure SetHint(const Value: String);
  39.     { Private declarations }
  40.   protected
  41.     { Protected declarations }
  42.     NotifyIconInfo: NOTIFYICONDATA;
  43.     procedure CreateNotifyIconData(var TrayIconInfo: NOTIFYICONDATA);
  44.     procedure WMMYTRAYICON (var Mes: TMessage); message WM_MYTRAYICON;
  45.   public
  46.     { Public declarations }
  47.     constructor create(AOwner: TComponent); override;
  48.     destructor destroy; override;
  49.   published
  50.     { Published declarations }
  51.     property Active: Boolean read FActive write SetActive;    
  52.     property Icon: TIcon read FIcon write SetIcon;
  53.     property Hint: String read FHint write SetHint;
  54.     //Definizione degli eventi
  55.     property OnLeftDown: TNotifyEvent read FOnLeftDown write FOnLeftDown;
  56.     property OnRightDown: TNotifyEvent read FOnRightDown write FOnRightDown;
  57.     property OnCenterDown: TNotifyEvent read FOnCenterDown write FOnCenterDown;
  58.     property OnLeftUp: TNotifyEvent read FOnLeftUp write FOnLeftUp;
  59.     property OnRightUp: TNotifyEvent read FOnRightUp write FOnRightUp;
  60.     property OnCenterUp: TNotifyEvent read FOnCenterUp write FOnCenterUp;
  61.     property OnDblClickLeft: TNotifyEvent read FOnDblClickLeft write FOnDblClickLeft;
  62.     property OnDblClickRight: TNotifyEvent read FOnDblClickRight write FOnDblClickRight;
  63.     property OnDblClickCenter: TNotifyEvent read FOnDblClickCenter write FOnDblClickCenter;
  64.  
  65.   end;
  66.  
  67. procedure Register;
  68.  
  69. implementation
  70.  
  71. uses ShellAPI;
  72.  
  73. procedure Register;
  74. begin
  75.   RegisterComponents('TDSoft', [TTDTrayIcon]);
  76. end;
  77.  
  78. { TTDTrayIcon }
  79.  
  80. constructor TTDTrayIcon.create(AOwner: TComponent);
  81. begin
  82.   inherited;
  83.   if not (AOwner is TForm) then
  84.   begin
  85.     ShowMessage('Parent Control is not a form');
  86.     Free;
  87.   end;
  88.   FIcon:=TIcon.create;
  89.   FActive:=False;
  90. end;
  91.  
  92. procedure TTDTrayIcon.CreateNotifyIconData(
  93.   var TrayIconInfo: NOTIFYICONDATA);
  94. begin
  95.   with TrayIconInfo do
  96.   begin
  97.     cbSize:=sizeOf(TrayIconInfo);
  98.     HWND:=Application.handle;
  99.     uID:=1;
  100.     uCallbackMessage:=WM_MYTRAYICON;
  101.     uFlags:=NIF_ICON or NIF_MESSAGE    or NIF_TIP;
  102.     szTip:=FHint;
  103.     hIcon:=FIcon.Handle;
  104.   end;
  105.  
  106. end;
  107.  
  108. destructor TTDTrayIcon.destroy;
  109. begin
  110.   Active:=False;
  111.   FreeAndNil(FIcon);
  112.   inherited;
  113. end;
  114.  
  115. procedure TTDTrayIcon.SetActive(const Value: Boolean);
  116. begin
  117.   FActive := Value;
  118.  
  119.   if not(csDesigning in ComponentState) then
  120.  
  121.   if FActive then
  122.   with NotifyIconInfo do
  123.   begin
  124.     cbSize:=sizeOf(NotifyIconInfo);
  125.     HWND:=(Owner as TForm).Handle;
  126.     uID:=1;
  127.     uCallbackMessage:=WM_MYTRAYICON;
  128.     uFlags:=NIF_ICON or NIF_MESSAGE    or NIF_TIP;
  129.     szTip:=FHint;
  130.     hIcon:=FIcon.Handle;
  131.     Shell_NotifyIcon(NIM_ADD,@NotifyIconInfo)
  132.   end
  133.   else
  134.     Shell_NotifyIcon(NIM_DELETE,@NotifyIconInfo);
  135.  
  136. end;
  137.  
  138. procedure TTDTrayIcon.SetHint(const Value: String);
  139. begin
  140.   FHint := Copy(Value,1,64);
  141. end;
  142.  
  143. procedure TTDTrayIcon.SetIcon(const Value: TIcon);
  144. begin
  145.   if FActive then
  146.     SetActive(False);
  147.  
  148.   FIcon.Assign(Value);
  149.  
  150.   SetActive(True);
  151.  
  152.  
  153. end;
  154.  
  155. procedure TTDTrayIcon.WMMYTRAYICON(var Mes: TMessage);
  156. begin
  157.   ShowMessage('Entrato');
  158.   case Mes.LParam of
  159.     WM_LBUTTONDOWN:
  160.       if Assigned(FOnLeftDown) then FOnLeftDown(self);
  161.     WM_LBUTTONUP:
  162.       if Assigned(FOnLeftUp) then FOnLeftUp(self);
  163.     WM_RBUTTONDOWN:
  164.       if Assigned(FOnRightDown) then FOnRightDown(self);
  165.     WM_RBUTTONUP:
  166.       if Assigned(FOnRightDown) then FOnRightDown(self);
  167.     WM_MBUTTONDOWN:
  168.       if Assigned(FOnCenterDown) then FOnCenterDown(self);
  169.     WM_MBUTTONUP:
  170.       if Assigned(FOnCenterUp) then FOnCenterUp(self);
  171.     WM_MBUTTONDBLCLK:
  172.       if Assigned(FOnDblClickCenter) then FOnDblClickCenter(self);
  173.     WM_LBUTTONDBLCLK:
  174.       if Assigned(FOnDblClickLeft) then FOnDblClickLeft(self);
  175.     WM_RBUTTONDBLCLK:
  176.       if Assigned(FOnDblClickRight) then FOnDblClickRight(self);
  177.   end;
  178.  
  179. end;
  180.  
  181. end.
  182.