Tooltip in Delphi

[badMF]

Hi, I hope to find the solution here....

I want my app to minimize to tray and to use tooltip icon (in systray) for some info for the user. I've tried to find some source code for this but it seams that no one wants to share "the secret". I hope that in this place I'll find the answer...

Thanks in advance for any hint or suggestions ;)

[radu84]

this what i've play a time ago

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,shellapi;
const

WM_CAllBack = WM_USER;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
   procedure go_to_tray(var msg:TMessage);message wm_syscommand;
   procedure WM_CALLBACKPRO(var msg : TMessage); message wm_callBack;
    { Public declarations }
  end;

var
  Form1: TForm1;
  tricon:HICON;
  TrayIcon : TNotifyIconData;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WM_CALLBACKPRO(var msg : TMessage);
var
p : TPoint;
begin

case msg.LParam of
 WM_LBUTTONDOWN :
  begin
    Shell_NotifyIcon(NIM_DELETE,@TrayIcon);
    Form1.Visible := True;
  end;
 end;
end;

procedure TForm1.go_to_tray(var msg: TMessage);
var tray:boolean;
begin
//
tray:=false;
 if msg.WParam=sc_minimize then
//  MessageDlg('ssss', mtWarning, [mbOK], 0);
  begin
         Form1.Visible := False;
         tricon:= application.Icon.Handle;
         Trayicon.cbSize := SizeOf(TNotifyIconData);
         Trayicon.Wnd := handle;
         Trayicon.szTip := 'acing';
         Trayicon.uID := 1;
         TrayIcon.hIcon := tricon;
         TrayIcon.uCallbackMessage := WM_CAllBack;
         Trayicon.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
         Shell_NotifyIcon(NIM_ADD,@trayicon);
//         formshow:=false;
//         form1.Hide;
         tray:=true;
         ShowWindow(Form1.Handle,SW_HIDE);
         ShowWindow(Application.Handle,SW_HIDE);
  end;

 inherited;
 if tray then
  begin
   ShowWindow(Form1.Handle,SW_HIDE);
   ShowWindow(Application.Handle,SW_HIDE);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MessageDlg('aa', mtWarning, [mbOK], 0);
end;

end.

another suggestion is to use cooltray component. is very usefull

if you want i think you'll find some good docs about this here:

http://delphi.about.com/od/kbwinshell/l/aa121801a.htm

and here

http://delphi.about.com/sitesearch.htm?terms=tray&SUName=delphi&TopNode=3176&type=1

best regards,

[delphidabbler]

To create a tray application you need three main things: (1) a (hidden?) window to receive messages from Windows about your tray icon (2) a Windows procedure for the window where you handle those messages and (3) calls to the Shell_NotifyIcon() API to add, modify and remove your icon.

Here's a sample class (extracted from a program I've just been working on, that does all those things. It also provides a menu when you right click the icon and activates the default menu item when double-clicked. You can tweak it to do other things.

unit UTrayIcon;

interface

uses
  Messages, Windows, Graphics, ShellAPI, Menus;

type

  TTrayIcon = class(TObject)
  private
    fWnd: HWND;
    fIcon: TIcon;
    fTip: string;
    fMenu: TPopupMenu;
    procedure DoDefaultMenuAction;
    procedure DisplayPopupMenu;
    procedure WndProc(var Msg: TMessage);
    procedure InitIconData(const Icon: TIcon; const Tip: string;
      out IconData: TNotifyIconData);
    procedure RegisterTrayIcon;
    procedure UnRegisterTrayIcon;
  public
    constructor Create(const Icon: TIcon; const Tip: string;
      const Menu: TPopupMenu);
    destructor Destroy; override;
    procedure SetTip(const Tip: string);
  end;

implementation

uses
  SysUtils, Classes;

const
  // message we receive from Windows when somethings happens to our icon
  CM_TRAY = WM_USER + 1; 

constructor TTrayIcon.Create(const Icon: TIcon; const Tip: string;
  const Menu: TPopupMenu);
begin
  Assert(Assigned(Icon)); // icon to display
  Assert(Assigned(Menu)); // popup menu for right clicks
  inherited Create;
  fWnd := AllocateHWnd(WndProc); // hidden window - see Delphi help
  fIcon := TIcon.Create;
  fIcon.Assign(Icon);
  fTip := Tip;
  fMenu := Menu;
  RegisterTrayIcon;
end;

destructor TTrayIcon.Destroy;
begin
  UnRegisterTrayIcon;
  FreeAndNil(fIcon);
  if fWnd <> 0 then
    DeallocateHWnd(fWnd);
  inherited;
end;

procedure TTrayIcon.DisplayPopupMenu;
var
  Pos: TPoint;
begin
  GetCursorPos(Pos);
  if Assigned(fMenu) then
    fMenu.Popup(Pos.X, Pos.Y);
end;

procedure TTrayIcon.DoDefaultMenuAction;
var
  Idx: Integer;
  MI: TMenuItem;
begin
  if not Assigned(fMenu) then
    Exit;
  // find default menu item if any and "click" it if found
  for Idx := 0 to Pred(fMenu.Items.Count) do
  begin
    MI := fMenu.Items[Idx];
    if MI.Default then
    begin
      MI.Click;
      Break;
    end;
  end;
end;

procedure TTrayIcon.InitIconData(const Icon: TIcon; const Tip: string;
  out IconData: TNotifyIconData);
begin
  // helper method to ease setting up TNotifyIconData structure
  // see Windows API help for NOTIFYICONDATA for details
  with IconData do
  begin
    cbSize := SizeOf(IconData);
    Wnd := fWnd;
    uID := 0;
    uFlags := NIF_MESSAGE; // says to use our callback message
    if Assigned(Icon) then
      uFlags := uFlags or NIF_ICON;  // says to use icon we provide
    if Tip <> '' then
      uFlags := uFlags or NIF_TIP; // says to use tooltip we provide
    uCallbackMessage := CM_TRAY;
    if Assigned(Icon) then
      hIcon := Icon.Handle // handle to our icon
    else
      hIcon := 0;
    StrPCopy(szTip, Tip); // info tip
  end;
end;

procedure TTrayIcon.RegisterTrayIcon;
var
  IconData: TNotifyIconData;
begin
  // adds tray icon
  InitIconData(fIcon, fTip, IconData);
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;

procedure TTrayIcon.SetTip(const Tip: string);
var
  IconData: TNotifyIconData;
begin
  // sets info tip for tray icon
  InitIconData(nil, Tip, IconData);
  Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TTrayIcon.UnRegisterTrayIcon;
var
  IconData: TNotifyIconData;
begin
  // removes tray icon
  InitIconData(fIcon, '', IconData);
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

procedure TTrayIcon.WndProc(var Msg: TMessage);
begin
  // check for our custom message
  if Msg.Msg = CM_TRAY then
  begin
    // we handle double click and right mouse click 
    case Msg.LParam of
      WM_LBUTTONDBLCLK: DoDefaultMenuAction;
      WM_RBUTTONDOWN: DisplayPopupMenu;
    end;
  end
  else
    // default processing for other messages
    Msg.Result := DefWindowProc(fWnd, Msg.Msg, Msg.WParam, Msg.LParam);
end;

end.

I hope that's clear from comments in code