Create TrayIcon with Menu

uses ShellApi, ComCtrls

const
  TrayIconMessage = WM_USER + 100;
  
private
    { Declarations privates }
    IconData: TNotifyIconData;
    AttendButtonUp: Boolean;
    procedure Icone;
    procedure SupprimeIcone;
    procedure WMTrayIconMessage(var Msg: TMessage);
      message TrayIconMessage;
      
//

procedure TForm1.Icone;
begin
  with IconData do
  begin
    hIcon := LoadIcon(HInstance, 'MAINICON');
    cbSize := SizeOf(IconData);
    Wnd := Handle;
    uID := 0;
    StrPCopy(szTip, Application.Title);
    uCallBackMessage := TrayIconMessage;
    uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  end;
  Shell_NotifyIcon(NIM_ADD, @IconData)
end;

procedure TForm1.SupprimeIcone;
begin
  IconData.uID := 0;
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

procedure TForm1.WMTrayIconMessage(var Msg: TMessage);
var P: TPoint;
begin
  case Msg.LParam of
    WM_LBUTTONDBLCLK: AttendButtonUp := True;
    WM_LBUTTONUP: if AttendButtonUp then
    begin
      AttendButtonUp := False;
      MenuRestaurerClick(Self);
      PopupMenu := nil;
    end;
    WM_RBUTTONUP:
    begin
      GetCursorPos(P);
      SetForegroundWindow(Handle);
      PopMnuSysTray.Popup(P.x, P.y);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Icone;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CheckBox1.Checked then
  begin
    Action := caNone;
    Hide;
    PopupMenu := PopMnuSysTray;
  end
  else
    SupprimeIcone;
end;

procedure TForm1.BtnCloseClick(Sender: TObject);
begin
  Close;
end;