Para hacer este truco añadir un popup a un formulario.
No olvideis añadir ShellApi, sino os dará problema el TNotifyIconData Recordar añadir al popup alguna opción para terminar la aplicación y para poder ver el popup. En WndProc se pueden añadir diferentes mensajes del ratón, entre otros, como:
Código:
WM_LBUTTONDBLCLK
WM_LBUTTONDOWN
WM_LBUTTONUP
WM_RBUTTONDBLCLK
WM_RBUTTONDOWN
WM_RBUTTONUP
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ShellApi;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Sonia1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Sonia1Click(Sender: TObject);
private
MessageIcon: Cardinal;
procedure RButtonUp;
protected
procedure WndProc(var Msg: TMessage); override;
public
procedure PonerIcono(operacion: word);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.PonerIcono (operacion: word);
var
IconoInfo: TNotifyIconData;
begin
with IconoInfo do
begin
cbSize := SizeOf(IconoInfo); uID := 0; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
Wnd := Self.Handle; uCallbackMessage := MessageIcon; hIcon := Application.Icon.Handle; szTip := 'Icono en la barra de tareas con menú'; end;
Shell_NotifyIcon(operacion, @IconoInfo);
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
if Msg.Msg = MessageIcon then
case Msg.LParam of
WM_RBUTTONUP: RButtonUp; end
else
inherited WndProc(Msg);
end;
procedure TForm1.RButtonUp;
var
Pt: TPoint;
begin
GetCursorPos(Pt); SetForegroundWindow(Application.Handle);
Application.ProcessMessages;
PopupMenu1.Popup(Pt.X, Pt.Y); end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowMainForm := False;
ShowWindow(Application.Handle, SW_HIDE);
MessageIcon := RegisterWindowMessage('Pon Icono');
PonerIcono (NIM_ADD);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PonerIcono (NIM_DELETE ) ;
end;
end.