{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2007 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}
unit ecSingleInst;

interface

uses Windows, Messages, Classes;

type
  TGetStrEvent = procedure(Sender: TObject; var S: string) of object;
  TAcceptStrEvent = procedure(Sender: TObject; S: string; var Accept: Boolean) of object;

  TsiSendParam = (siNone, siFirstParam, siAllParams);

  TecSingleInstance = class(TComponent)
  private
    FActive: Boolean;
    FWindowHandle: HWND;
    FAcceptInstInfo: TAcceptStrEvent;
    FGetInstInfo: TGetStrEvent;
    FSendParam: TsiSendParam;
  protected
    procedure Loaded; override;
    procedure WndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write FActive default True;
    property GetInstInfo: TGetStrEvent read FGetInstInfo write FGetInstInfo;
    property AcceptInstInfo: TAcceptStrEvent read FAcceptInstInfo write FAcceptInstInfo;
    property SendParam: TsiSendParam read FSendParam write FSendParam default siFirstParam;
  end;


implementation

uses SysUtils, Forms;

// Main window (window of class MainWndClass) must process this message.
// Message.Result should be 1.
const
   WM_TESTMAININSTANCE = WM_USER + 101;

{ TecSingleInstance }

constructor TecSingleInstance.Create(AOwner: TComponent);
begin
  inherited;
  FActive := True;
  FSendParam := siFirstParam;
end;

destructor TecSingleInstance.Destroy;
begin
  if FWindowHandle <> 0 then
    {$IFNDEF EC_VCL5}Classes.{$ENDIF}DeallocateHWnd(FWindowHandle);
  inherited;
end;

var
  SI_WindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil);

function LookAtAllWindows(Handle: HWND; WndClass: LongInt): BOOL; stdcall;
var ClassName: Array[0..255] of Char;
    S: String;
    Atom: TAtom;
    cmp: TecSingleInstance;
    i: integer;
begin
  Result:= True;
  cmp := TecSingleInstance(WndClass);

  if (GetClassName(Handle, ClassName, SizeOf(ClassName)) > 0) and
     (('TecSingleInst_' + cmp.Name) = ClassName) then
   begin
    S := '';
    case cmp.SendParam of
      siFirstParam:
         if ParamCount > 0 then S := ParamStr(1);
      siAllParams:
         for i := 1 to ParamCount - 1 do
           begin
             if i > 1 then S := S + ';';
             S := S + ParamStr(i);
           end;
    end;
    if (ParamCount = 0) or (cmp.SendParam = siNone) then S := '' else
      if cmp.SendParam = siFirstParam then S := ParamStr(1) else

    if Assigned(cmp.GetInstInfo) then
      cmp.GetInstInfo(cmp, S);
    Atom := GlobalAddAtom(PChar(S));
    Result := SendMessage(Handle, WM_TESTMAININSTANCE, Atom, 0) <> 1;
    GlobalDeleteAtom(Atom);
    if not Result then
      Halt;
   end;
end;

procedure TecSingleInstance.Loaded;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
  ClsName: string;
begin
  inherited;

  if csDesigning in ComponentState then Exit;

  ClsName := 'TecSingleInst_' + Name;

  if FActive then
    EnumWindows(@LookAtAllWindows, Integer(Self));

  SI_WindowClass.hInstance := HInstance;
{$IFDEF PIC}
  SI_WindowClass.lpfnWndProc := @DefWindowProc;
{$ENDIF}
  ClassRegistered := GetClassInfo(HInstance, PChar(ClsName), TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(PChar(ClsName), HInstance);
    SI_WindowClass.lpszClassName := PChar(ClsName);
    Windows.RegisterClass(SI_WindowClass);
  end;
  FWindowHandle := CreateWindowEx(WS_EX_TOOLWINDOW, PChar(ClsName),
    '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  SetWindowLong(FWindowHandle, GWL_WNDPROC, Longint({$IFNDEF EC_VCL5}Classes.{$ENDIF}MakeObjectInstance(WndProc)));
end;

procedure TecSingleInstance.WndProc(var Message: TMessage);
var PC: array[0..MAX_PATH] of Char;
    Accept: Boolean;
    len: integer;
begin
  Message.Result := 0;
  if FActive and (Message.Msg = WM_TESTMAININSTANCE) then
   begin
    Accept := True;
    len := GlobalGetAtomName(Message.wParam, PC, MAX_PATH - 1);
    PC[len] := #0;
    try
      if Assigned(FAcceptInstInfo) then
        FAcceptInstInfo(Self, PC, Accept);
      if not Accept then
        Exit;
    except
      Application.HandleException(Self);
    end;
    Message.Result := 1;
    Application.Restore;
    BringWindowToTop(Application.Handle);
   end;
  Dispatch(Message);
end;

end.
