unit MyTrayApp;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, LCLIntf, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, Windows, ShellAPI, LazUTF8;
const
uIDTrayIcon = 25;
WM_ICONTRAY = WM_USER + uIDTrayIcon;
type
TNotifyIconDataW2 = record
cbSize: DWORD;
hWnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..127] of WideChar;
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array [0..255] of WideChar;
u: record
case longint of
0 : ( uTimeout : UINT );
1 : ( uVersion : UINT );
end;
szInfoTitle: array[0..63] of WideChar;
dwInfoFlags: DWORD;
end;
{ TMyTestComponent }
TMyTrayApp = class(TComponent)
private
fNotifyIcon : TNotifyIconDataW2;
fHWND : HWND;
protected
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function AddIcon : Boolean;
procedure WndProc(var Msg: TMessage);
published
end;
procedure Register;
var
fPrevWndProc : WndProc;
implementation
//{$R myselectdialog.res}
function WideStrLCopy(dest, source: PWideChar; maxlen: SizeInt): PWideChar;
var
counter: SizeInt;
begin
counter := 0;
while (Source[counter] <> #0) and (counter < MaxLen) do
begin
Dest[counter] := Source[counter];
Inc(counter);
end;
Dest[counter] := #0;
Result := Dest;
end;
constructor TMyTrayApp.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
fHWND := AllocateHWnd(@WndProc);
if not (csDesigning in ComponentState) then
begin
AddIcon;
end;
end;
destructor TMyTrayApp.Destroy;
begin
Shell_NotifyIconW(NIM_DELETE, @fNotifyIcon);
DeallocateHWnd(fHWND);
inherited;
end;
procedure TMyTrayApp.WndProc(var Msg: TMessage);
begin
if Msg.msg = WM_ICONTRAY then
begin
case Msg.lParam of
WM_LBUTTONDOWN : begin
(Self.Owner as TForm).Show;
end;
WM_RBUTTONDOWN : begin
(Self.Owner as TForm).Hide;
end;
end;
end;
end;
function TMyTrayApp.AddIcon : Boolean;
var
WideBuffer: widestring;
begin
FillChar(fNotifyIcon, SizeOf(fNotifyIcon), 0);
fNotifyIcon.cbSize := SizeOf(fNotifyIcon);
fNotifyIcon.hWnd := fHWND;
fNotifyIcon.uID := uIDTrayIcon;
fNotifyIcon.uFlags := NIF_MESSAGE or NIF_ICON;
fNotifyIcon.uFlags := fNotifyIcon.uFlags or NIF_TIP;
fNotifyIcon.uCallbackMessage := WM_USER + uIDTrayIcon;
fNotifyIcon.hIcon := Application.Icon.Handle;
WideBuffer := UTF8ToUTF16('TrayIconHint');
WideStrLCopy(@fNotifyIcon.szTip, PWideChar(WideBuffer), 127);
Result := Shell_NotifyIconW(NIM_ADD, @fNotifyIcon);
end;
procedure Register;
begin
RegisterComponents('Misc',[TMyTrayApp]);
end;
end.