TrayIcon without Components

Wenn man sein Programm als TrayIcon mit Menü von der Taskleiste steuern möchte, ist meistens Zusatzsoftware oder Komponenten nötig, die teilweise Geld kosten und auch nicht immer das Versprechen, was man erwartet.

Es geht aber auch ohne all das.

Hier ein Beispiel, es wird Benötigt : 1xPopUpMenu

uses Menus, ShellApi, ComCtrls

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

procedure TForm1.Icon;
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;
      RestoreClick(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
  Icon;
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.RestoreClick(Sender: TObject);
begin
  if not Visible then
  begin
    Visible := True;
    ShowWindow(Application.Handle, SW_SHOW);
  end;
end;

procedure TForm1.CloseClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.Terminate;
end;