unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
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;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
function AddIcon : Boolean;
function ShowMessageN : Boolean;
procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
public
end;
var
Form1: TForm1;
bFirst : Boolean = True;
NotifyIcon: TNotifyIconDataW2;
implementation
{$R *.lfm}
{ TForm1 }
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;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessageN;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Windows.Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if bFirst then
begin
Hide;
bFirst := False;
end;
AddIcon;
end;
procedure TForm1.TrayMessage(var Msg: TMessage);
begin
case Msg.lParam of
WM_LBUTTONDOWN : begin
Show;
end;
WM_RBUTTONDOWN : begin
Hide;
end;
end;
end;
function TForm1.ShowMessageN : Boolean;
const
FlagsMap: array[TBalloonFlags] of dword = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
var
NotifyData: TNotifyIconDataW2;
w: WideString;
begin
NotifyData.cbSize:=SizeOf(NotifyData);
NotifyData.hWnd := Self.Handle;
NotifyData.uID := uIDTrayIcon;
NotifyData.uFlags:=NIF_INFO;
w:=UTF8ToUTF16('BalloonHint');
WideStrLCopy(@NotifyData.szInfo, PWideChar(w), High(NotifyData.szInfo));
w:=UTF8ToUTF16('BalloonTitle');
WideStrLCopy(@NotifyData.szInfoTitle, PWideChar(w), High(NotifyData.szInfoTitle));
NotifyData.dwInfoFlags:=FlagsMap[bfInfo];
// NotifyData.szInfo[0] := #0; // < This doesn't work
Result := Shell_NotifyIconW(NIM_MODIFY, @NotifyData);
end;
function TForm1.AddIcon : Boolean;
var
WideBuffer: widestring;
begin
FillChar(NotifyIcon, SizeOf(NotifyIcon), 0);
NotifyIcon.cbSize := SizeOf(NotifyIcon);
NotifyIcon.hWnd := Self.Handle;
NotifyIcon.uID := uIDTrayIcon;
NotifyIcon.uFlags := NIF_MESSAGE or NIF_ICON;
NotifyIcon.uFlags := NotifyIcon.uFlags or NIF_TIP;
NotifyIcon.uCallbackMessage := WM_USER + uIDTrayIcon;
NotifyIcon.hIcon := Application.Icon.Handle;
WideBuffer := UTF8ToUTF16('Hint');
WideStrLCopy(@NotifyIcon.szTip, PWideChar(WideBuffer), 127);
Result := Shell_NotifyIconW(NIM_ADD, @NotifyIcon);
end;
end.