Solved

Putting Delphi 6.0 application to the system tray?

Posted on 2003-10-22
6
436 Views
Last Modified: 2010-05-18
Hi,

I am new to delphi. But I am getting the hang of it after help from you experts.

I am currently working on a program that I would like to do while in the system tray. When the program is run it should open up a form, but when minimised or pressed a button(OK), it should disappear and work in the system tray.

The problem is in Delphi, I don't know how that works. I mean how to put the program to the system tray. And also while in the sytem tray, I would like the icon to change upon request by the program code. For example when a certain condition occurs.

So, I was wondering if you experts could help me out here. How the code is like and what components or file I should have to accomplish this and also where I can get it.

I know I can count on you experts. Thank you...
0
Comment
Question by:warheat001
6 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 9598239
usually you may find some components at www.torry.net
wehich handle this for you

addtional a sample from my paq


shows the mouse-cursor pos in the tray by usage of three Icons, which are created and updated on the fly

unit tray_ico_u;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const MyIconIDs : array[0..2] of Integer = (1000,1001,1002);

var
  IconInfo : TIconInfo;
  MyIcons : array[0..2] of TIcon;
  NotifyIconData : TNotifyIconData;

procedure TForm1.FormCreate(Sender: TObject);
var i : Integer;
begin
  for i := 0 to 2 do  //Push three Icons in the Tray
  begin
    MyIcons[i] := TIcon.Create;
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;
    if Shell_NotifyIcon(NIM_ADD, @NotifyIconData) then;
  end;
  Timer1.Interval := 100;  //Enable Timer
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i : Integer;
begin
  for i := 0 to 2 do   //Remove the Icons from the Tray
  begin
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;
    if Shell_NotifyIcon(NIM_DELETE, @NotifyIconData) then
      MyIcons[i].Free;
  end;
end;


//The timer event
procedure TForm1.Timer1Timer(Sender: TObject);
var
  MyBmp : TBitMap;
  P : TPoint;
  i,x,y : Integer;
  s : String;
  MB : Array[0..2] of TBitmap;
begin
  Timer1.enabled := False;  //prevent that the event comes twice
  MyBmp := TBitMap.Create;  //Prepare Source Bitmap
  MyBmp.Height := MyIcons[1].Height;
  MyBmp.Width := MyIcons[1].Width * 3;
  MyBmp.Canvas.Brush.Color := clBlue;  //comes black on yellow in the tray
  MyBmp.Canvas.FillRect(Rect(0,0,MyBmp.width,MyBmp.Height));
  MyBmp.Canvas.Font.Size := 20;
  for i := 0 to 2 do  //prepare secondary Bitmaps
  begin
    MB[I] := TBitMap.Create;
    MB[I].Width := MyIcons[i].Width;
    MB[i].Height := MyIcons[i].height;
  end;
  GetCursorPos(P);  //Get current Mousepos
  s := Inttostr(p.x)+':'+Inttostr(P.y); //prepare String
  y := (MyBmp.Height div 2) - (MyBmp.Canvas.TextHeight(S) div 2);
  x := (MyBmp.Width div 2) - (MyBmp.Canvas.TextWidth(S) div 2);
  MyBmp.Canvas.TextOut(x,y,s);
    Image1.Picture.Bitmap.Assign(MyBmp);  //Controlling on the form, can deleted
  for i := 0 to 2 do  //Create Icons
  begin
    MB[I].Canvas.CopyRect(Rect(0,0,MB[I].Width,MB[I].Height),
                          MyBmp.Canvas,
                          Rect(MB[i].Width * i,0,MB[i].Width * (i+1),MB[I].Height));
    MyIcons[i].ReleaseHandle; //Free Resource
    IconInfo.fIcon := True;
    IconInfo.xHotspot := 0;
    IconInfo.yHotspot := 0;
    IconInfo.hbmColor := MB[i].Handle;
    IconInfo.hbmMask := MB[i].MaskHandle;  //Doesn't work yet
    MyIcons[I].Handle := CreateIconIndirect(IconInfo);

    //changes to the tray
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;

    Shell_NotifyIcon(NIM_Modify, @NotifyIconData);

    MB[i].Free
  end;
  MyBmp.Free;
  Timer1.enabled := True;  //prepare for next event
end;

end.

meikl ;-)
0
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 9598272
There are several components that do this but here's an example that uses only the Windows API:
---------------------------------------------------------------------
program Restart;

{$R *.RES}

uses
  Windows,
  Messages,
  ShellAPI,
  WinSvc;

const
  UWM_TRAYICON = WM_USER + 10;
  MENUITEM_START = 101;
  MENUITEM_STOP = 102;
  MENUITEM_EXIT = 199;
  ID_TRAYICON = 1;
  ExStyle = WS_EX_TOOLWINDOW;
  Style = WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX;
  sW3SVCWndClass = 'WWW Publishing Service Control';
  sServiceName = 'W3SVC';
  DefaultNotify: TNotifyIconData = (
    cbSize: SizeOf(TNotifyIconData);
    Wnd: 0;
    uID: ID_TRAYICON;
    uFlags: NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallBackMessage: UWM_TRAYICON;
    hIcon: 0;
    szTip: 'W3SVC service control';
    );

var
  StopApp: Boolean = False;
  W3SVCWndClass: TWndClass = (
    style: CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc: nil;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: color_btnface + 1;
    lpszMenuName: nil;
    lpszClassName: sW3SVCWndClass);

function AddTrayIcon(AHandle: THandle): Boolean;
var
  NotifyIconData: TNotifyIconData;
begin
  NotifyIconData := DefaultNotify;
  NotifyIconData.Wnd := AHandle;
  NotifyIconData.hIcon := LoadIcon(hInstance, 'MAINICON');
  Result := Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;

function DeleteTrayIcon(AHandle: THandle): Boolean;
var
  NotifyIconData: TNotifyIconData;
begin
  NotifyIconData := DefaultNotify;
  NotifyIconData.Wnd := AHandle;
  Result := Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
end;

var
  FManager: SC_HANDLE;
  FService: SC_HANDLE;
  AHandle: THandle;
  AMsg: TMsg;
  MutexHandle: THandle;
  ServiceStatus: TServiceStatus;

function W3SVCRunning: Boolean;
begin
  Result := False;
  FManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if (FManager <> 0) then begin
    FService := OpenService(FManager, sServiceName, SERVICE_ALL_ACCESS);
    if (FService = 0) then begin
      CloseServiceHandle(FManager);
      FManager := 0;
    end
    else begin
      if QueryServiceStatus(FService, ServiceStatus) then begin
        Result := (ServiceStatus.dwCurrentState = SERVICE_RUNNING);
      end;
    end;
    CloseServiceHandle(FManager);
    FManager := 0;
    if (FService <> 0) then begin
      CloseServiceHandle(FService);
      FService := 0;
    end;
  end;
end;

procedure W3SVCFlip;
var
  Wait: Integer;
  AllOK: Boolean;
  lpServiceArgVectors: PChar;
begin
  FManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if (FManager <> 0) then begin
    FService := OpenService(FManager, sServiceName, SERVICE_ALL_ACCESS);
    if (FService = 0) then begin
      CloseServiceHandle(FManager);
      FManager := 0;
    end
    else begin
      if (ServiceStatus.dwCurrentState = SERVICE_RUNNING) then begin
        if ControlService(FService, SERVICE_CONTROL_STOP, ServiceStatus) then begin
          Wait := 150;
          AllOK := QueryServiceStatus(FService, ServiceStatus);
          while AllOK and (Wait > 0) and (ServiceStatus.dwCurrentState <> SERVICE_STOPPED) do begin
            Sleep(100);
            dec(Wait);
            AllOK := QueryServiceStatus(FService, ServiceStatus);
          end;
        end;
      end
      else if (ServiceStatus.dwCurrentState = SERVICE_STOPPED) then begin
        lpServiceArgVectors := nil;
        StartService(FService, 0, lpServiceArgVectors);
        Wait := 150;
        AllOK := QueryServiceStatus(FService, ServiceStatus);
        while AllOK and (Wait > 0) and (ServiceStatus.dwCurrentState <> SERVICE_RUNNING) do begin
          Sleep(100);
          dec(Wait);
          AllOK := QueryServiceStatus(FService, ServiceStatus);
        end;
      end;
    end;
    CloseServiceHandle(FManager);
    FManager := 0;
    if (FService <> 0) then begin
      CloseServiceHandle(FService);
      FService := 0;
    end;
  end;
end;

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
const
  FirstCall: Boolean = True;
  OldRunning: Boolean = True;
var
  Menu: HMENU;
  Pt: TPoint;
begin
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  if (uMsg = WM_CONTEXTMENU) then begin
    GetCursorPos(Pt);
    Menu := CreatePopupMenu;
    if W3SVCRunning then begin
      AppendMenu(Menu, MFT_STRING, MENUITEM_STOP, '&Stop WWW Publishing Service ');
    end
    else begin
      AppendMenu(Menu, MFT_STRING, MENUITEM_START, '&Start WWW Publishing Service ');
    end;
    AppendMenu(Menu, MFT_SEPARATOR, WM_NULL, '-');
    AppendMenu(Menu, MFT_STRING, MENUITEM_EXIT, 'E&xit');
    TrackPopupMenu(Menu, TPM_RIGHTBUTTON or TPM_TOPALIGN or TPM_LEFTALIGN, Pt.x, Pt.y, 0, hWnd, nil);
    DestroyMenu(Menu);
  end
  else if (uMsg = UWM_TRAYICON) then begin
    if (lParam = WM_LBUTTONDOWN) or (lParam = WM_RBUTTONDOWN) then begin
      PostMessage(hWnd, WM_CONTEXTMENU, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN));
    end;
  end
  else if (uMsg = WM_TIMER) then begin
    // Check if server is running.
  end
  else if (uMsg = WM_COMMAND) then begin
    if (LOWORD(wParam) = MENUITEM_EXIT) then begin
      PostQuitMessage(0);
    end
    else if (LOWORD(wParam) = MENUITEM_STOP) or (LOWORD(wParam) = MENUITEM_START) then begin
      W3SVCFlip;
    end;
  end
  else if (uMsg = WM_DESTROY) then begin
    StopApp := True;
  end;
end;

begin
  MutexHandle := CreateMutex(nil, True, sW3SVCWndClass);
  if (GetLastError = ERROR_ALREADY_EXISTS) then begin
    CloseHandle(MutexHandle);
  end
  else begin
    try
      W3SVCWndClass.lpfnWndProc := @WindowProc;
      RegisterClass(W3SVCWndClass);
      AHandle := CreateWindowEx(ExStyle, sW3SVCWndClass, nil, Style, 0, 0, 10, 10, GetDesktopWindow, 0, hInstance, nil);
      AddTrayIcon(AHandle);
      UpdateWindow(AHandle);
      while (GetMessage(aMsg, AHandle, 0, 0)) and not StopApp do begin
        TranslateMessage(aMsg);
        DispatchMessage(aMsg);
      end;
      DeleteTrayIcon(AHandle);
    finally
      ReleaseMutex(MutexHandle)
    end;
  end;
end.
---------------------------------------------------------------------
I wrote above code once to start and stop my webserver using a simple trayicon. The magic is inside the AddTrayIcon and DeleteTrayIcon which both call the same Windows API: Shell_NotifyIcon. This shell function has several other purposes too and is the only function you need to work with trayicon applications.
Now, the trayicon also needs to know a handle of a window that will handle the trayicon messages. This window will get a message from the trayicon handler and will have to respond to it. In my case I kept the final code very small by using the Windows API only but if you use the VCL it will just be a lot easier. Just pop up a popup menu or do whatever else is required when you get that message.
The configuration of the trayicon is handled by the TNotifyIconData record. You have to set it up correctly and then it will work quite nicely. For above tool I provided the trayicon the ID of the message that it will send to the window (UWM_TRAYICON), an unique ID (ID_TRAYICON) just in case my application has more than one icon and some flags telling the trayicon what kind of icon it is (NIF_MESSAGE or NIF_ICON or NIF_TIP).
Check out the MSDN site and other webpages for more information about Shell_NotifyIcon. It is the only function you'll have to learn. ;-)
0
 

Author Comment

by:warheat001
ID: 9598586
Wow...

Sorry to say this, but I don't understand the codes at all.

Could you tell me in detail what I must do to make it work. I mean what should I do. Where should I paste the code.

I just moved on to Delphi and it hasn't been a week. So could I get alittle beginner's version of an answer...

Thank you
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 27

Accepted Solution

by:
kretzschmar earned 50 total points
ID: 9599001
well, then just go to www.torry.net
go to search keyword trayicon

there are some free components,
download one or more install it
and drop it then one your form
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 9599094
Warheat001,
  I guess this thread at ex-ex has a simple solution with explanation.
  Hope it helps :)
...S
http://www-level3.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20743321.html
0
 
LVL 17

Expert Comment

by:geobul
ID: 9604883
Hi,

I use this skeleton in my apps:

uses ..., ShellApi;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu; // popup menu for the tray with two options: show and exit
    mnuTrayShow: TMenuItem;
    mnuTrayExit: TMenuItem;
     procedure ToTray;
     procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuTrayShowClick(Sender: TObject);
    procedure mnuTrayExitClick(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure WndProc(var Msg : TMessage); override;
  public
    { Public declarations }
    IconNotifyData : TNotifyIconData;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses unit2, Tools;

procedure TForm1.ToTray;
begin
  Form1.Hide;
end;

procedure TForm1.WndProc(var Msg : TMessage);
var
   p : TPoint;
begin
  case Msg.Msg of
    WM_USER+1:
    case Msg.lParam of
      WM_RBUTTONUP: begin // show popup menu with two options: show and exit
        GetCursorPos(p);
        PopupMenu1.Popup(p.x, p.y);
      end;
      WM_LBUTTONUP: begin
         mnuTrayShowClick(Self);
      end;
    end;
  end;
  if (Msg.Msg = WM_SYSCOMMAND) and (Msg.wParam = SC_MINIMIZE) then begin
    ToTray;
    Msg.wParam := 0;
    Msg.lParam :=0;
  end;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with IconNotifyData do begin
    hIcon :=Application.Icon.Handle;
    uCallbackMessage := WM_USER + 1;
    cbSize := sizeof(IconNotifyData);
    Wnd := Handle;
    uID := 100;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  end;
  StrPCopy(IconNotifyData.szTip, 'CD FTP');
  Shell_NotifyIcon(NIM_ADD, @IconNotifyData);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
  Application.ProcessMessages;
end;

procedure TForm1.mnuTrayShowClick(Sender: TObject);
begin
  Form1.Show;
  Application.BringToFront;
end;

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

end.

Regards, Geo
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now