oneinstance.pas

Metric Converter is an useful tool for metric conversion, weight conversion, area conversion, mass c

unit OneInstance;

interface

uses Forms, Windows, Dialogs, SysUtils, Registry;

const
  MI_NO_ERROR          = 0;
  MI_FAIL_SUBCLASS     = 1;
  MI_FAIL_CREATE_MUTEX = 2;

var
  FirstInstance : Boolean;

{ Query this function to determine if error occurred in startup. }
{ Value will be one or more of the MI_* error flags. }
function GetMIError: Integer;

implementation

var
  MutHandle: THandle = 0;
  MessageId: Integer;
  WProc: TFNWndProc = Nil;
  MIError: Integer = 0;
  UniqueAppStr,
  Exe_Path,
  ExeName: PChar;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam,
                    lParam: Longint): Longint; StdCall;
begin
  { If this is the registered message... }
  if Msg = MessageID then
    begin

      { if main form is minimized, normalize it }
      if IsIconic(Application.Handle) then
        begin
          if Application.MainForm <> nil then
            Application.MainForm.WindowState := wsNormal;
          Application.Restore;
        end;
        Application.Restore;  // pw
        Application.BringToFront;
      //  BringWindowToTop(Application.Handle); //pw

      { set focus to this application  }
      if Application.MainForm <> nil then
        SetForegroundWindow(Application.MainForm.Handle);

      Result := 0;
    end
  { Otherwise, pass message on to old window proc }
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  { We subclass Application window procedure so that }
  { Application.OnMessage remains available for user. }
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
                                    Longint(@NewWndProc)));
  { Set appropriate error flag if error condition occurred }
  if WProc = Nil then
    MIError := MIError or MI_FAIL_SUBCLASS;
end;

procedure DoFirstInstance;
begin
  FirstInstance := True;
  SubClassApplication;
  MutHandle := CreateMutex(Nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_FAIL_CREATE_MUTEX;
end;

procedure BroadcastFocusMessage;
{ This is called when there is already an instance running. }
begin
  { Don't flash main form }
  Application.ShowMainForm := False;
  { Post message and inform other instance to focus itself }
  PostMessage(HWND_BROADCAST, MessageID, 0, 0);
  Application.Terminate;
  Application.ProcessMessages;
end;

procedure InitInstance;
begin
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
  if MutHandle = 0 then
    { Mutex object has not yet been created, meaning that no previous }
    { instance has been created. }
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;

initialization
  FirstInstance := False;
  Exe_Path := PChar(Application.ExeName);
  ExeName := PChar(ExtractFileName(Exe_Path));
  UniqueAppStr := ExeName;
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  if WProc <> Nil then
    { Restore old window procedure }
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
end.