Question

I have a delphi app that runs minimized to a tray icon. When the tray icon is double clicked the app opens a non-modal user interface form.

I have added logic to the app to detect whether it is already running. If it isn't running, it starts up and miminizes itself to the tray.

If it is already running, I want it to pass control to the first instance of itself and open the non-modal form, and then exit (the second instance). What's the best way to do this?

TIA R

Was it helpful?

Solution

Microsoft way is not flawless, so i do prefer old school:

const WM_KNOCK_KNOCK = WM_USER + 42;
{ or WM_USER + 265 or any number you like, consult PSDK documentation why WM_USER range }
{ or do RegisterWindowMessage }

{...}

procedure TMainForm.FormCreate(Sender: TObject);
var
  Window: HWND;
begin 
  Window := FindWindow(PChar({MainForm.}ClassName), nil);
  { 
  i neither remember how it works exactly nor have time to investigate right now, 
  so quick and dirty validity test follows:
  }
  Assert(not (HandleAllocated and (Window = Handle)), 'failed, use fallback');
  {
  if Window <> 0 then
  begin
    PostMessage(Window, WM_KNOCK_KNOCK, 0, 0);
    Halt;
  end;

  { regular initialization }

end;

Now, WM_KNOCK_KNOCK message handler of first instance performs wakeup routine.


i have little clue what exactly you do when you receive WM_LBUTTONUP (or perhaps WM_LBUTTONDBLCLK) in your Shell_NotifyIcon wrapper (Application.Restore, maybe?). As, Chris Thornton said, there is no such state as 'minimized to tray', it is artifical.


Fallback: if assertion fails, note what code depends only on class function ClassName so could be easily moved out of FormCreate and invoked before Application creates it.

OTHER TIPS

The recommended method of detecting another instance of a given application is for that application to create a named mutex or lock a file in a well known location, so that the second instance will trigger an error when you try to create the same mutex or lock the same file. Once you know there's another instance running, you can find the process handle for that instance and send it a message to restore if its minimized.

program Only_One_Mutex;

//undefine this   {.$define useMutex} to make it a multi instance app.
{$define useMutex}

uses
  Forms,
  Windows,
  Messages,
  MainForm in 'MainForm.pas' {frmMain};

{$R *.res}

{$ifdef useMutex}
var
  Mutex : THandle;
{$endif}


function pBuffStr( Var S1: String; S:String ): PChar;
begin
  FillChar(S1,SizeOf(S1),#0); {clear out the destination string}
  S1:= S+#0;                  {set it equal the source}
  Result:= @S1[1];            {result is a PChar pointer }
end;

procedure WindowToTop( WN: String );
  var
    iTitle: integer;
    S1,S  : String;
    Done: Boolean;
begin
  Done:= False;
  While NOT Done do begin
    if Pos(';',WN) > 0 then begin
      S:= Copy(WN,1,Pos(';',WN)-1);
      WN:= Copy(WN,Pos(';',WN)+1,Length(WN));
    end else begin
      S:= WN;
      Done:= True;
    end; {if Pos}
    iTitle:= FindWindow( nil, pBuffStr(S1,S) );
    if iTitle <> 0 then
      if NOT SetForegroundWindow( iTitle ) then
        GetLastError();
    Application.ProcessMessages;
  end; {while NOT Done}
end;

procedure RestoreWindow( WN: String );
  var
    iTitle: integer;
    Dest, S  : String;
    Done: Boolean;
begin
  Done:= False;
  While NOT Done do begin
    if Pos(';',WN) > 0 then begin             {is there more than ONE name}
      S:= Copy(WN,1,Pos(';',WN)-1);           {copy the first name of the original}
      WN:= Copy(WN,Pos(';',WN)+1,Length(WN)); {reduce the original string}
    end else begin
      S:= WN;                                 {only one name, so copy it}
      Done:= True;                            {this loop is done}
    end; {if Pos}
    iTitle:= FindWindow( nil, pBuffStr(Dest,S) ); {search for the window name}
    if iTitle <> 0 then                           {if found, then restore it}
      DefWindowProc(iTitle, WM_SYSCOMMAND, SC_RESTORE, SC_RESTORE);
  end; {while NOT Done}
end;


//=================================================================

procedure AppRun;
begin
  Application.Initialize;
  Application.Title := 'Only One Prog';
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end;

begin

{$ifdef useMutex}
  //global var declarations in the mainform.
  {=====================================================================}
  //ATitle MUST match the assigned Application.Title in AppRun
  //and Application.Title can "NOT" be a constant or var.
  ATitle   := 'Only One Prog';

  { THIS IS HOW IT KEEPS THE SECOND INSTANCE FROM STARTING,
    by using a MUTEX, and a MAINFORM window title  }
  //any text appender will work.
  AMutex   := ATitle + ' Mutex Thu, Jul/12/2012';

  //mainform's caption
  ACaption := ATitle + ', Mainform Caption';

  //a label on the mainform
  ALabel   := ATitle + ', MainForm Label-using mutex';
  {=====================================================================}

  Mutex := CreateMutex(nil, True, PAnsiChar( AMutex ));
  if (GetLastError = ERROR_ALREADY_EXISTS) then begin
    try
      RestoreWindow( ACaption );
      WindowToTop( ACaption );       //main form's name
    finally
      CloseHandle(Mutex);
    end;
  end else
    if  (Mutex <> 0)
    AND (GetLastError <> ERROR_ALREADY_EXISTS)
    then begin
     try
       AppRun;
     finally
       CloseHandle(Mutex);
     end;
    end;
{$else}
  //global var declarations in the mainform.
  {=====================================================================}
  ATitle   := 'More than One';                  //global declaration in the mainform.
  //mainform's caption - THIS IS HOW IT KEEPS THE SECOND INSTANCE FROM STARTING
  ACaption := ATitle + ', Mainform Caption';//global declaration in the mainform.
  //a label on the mainform
  ALabel   := ATitle + ', MainForm Label-multi exe';  //global declaration in the mainform.
  {=====================================================================}
  AppRun;
{$endif}

end.


unit MainForm;

interface

uses
  Windows, Messages, SysUtils,
  Variants, Classes, Graphics,
  Controls, Forms,   Dialogs, StdCtrls, LblEffct;


type
  TfrmMain = class(TForm)
    le1: TLabelEffect;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

  //these GLOBAL vars, are assigned values in the program source (.dpr) file.
  ATitle,
  ACaption,
  ALabel,
  AMutex  :String;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Caption     := ACaption;     //used to ID this form...
  le1.Caption := ALabel;
end;

end.
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top