FutureWindows.pas

{
This software is distributed under the BSD license.

Copyright (c) 2011, Tomasz Maszkowski
All rights reserved.

Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice, this
  list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
  this list of conditions and the following disclaimer in the documentation
  and/or other materials provided with the distribution.
- The name of Tomasz Maszkowski may not be used to endorse or promote
  products derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

History:
 2011-08-08 - [tm] initial thread-based version
 2011-08-09 - [tm] refactored to non-threaded implementation
 2011-08-11 - [tm] added support for anonymous methods and exception handling

TODO:
  - support for ansi/unicode windows

Usage:

  procedure test();
  begin
    TFutureWindows.Expect(MESSAGE_BOX_WINDOW_CLASS)
      .ExecProc(
        procedure (const AWindow: IWindow)
        begin
          AWindow.Text := 'Test';
        end
      )
      .ExecCloseWindow();

    MessageBox(0, 'testing future window', '', MB_OK);
  end;

}
{.$define EnableLogging}
unit FutureWindows;
interface
uses
  Windows,
  Classes,
  Controls,
  SysUtils;

const
  MESSAGE_BOX_WINDOW_CLASS = '#32770';
  DEFAULT_WAIT_TIME_SECS = 5.0;
type
  IWindow = interface
    ['{1756ADCA-62F2-4B2C-BF04-2A7FDC993A5D}']
    function GetAsControl: TControl;
    function GetHandle: HWND;
    function GetHeight: Integer;
    function GetParent: IWindow;
    function GetProcessId: Cardinal;
    function GetRect: TRect;
    function GetText: string;
    function GetTextLen: Integer;
    function GetThreadId: Cardinal;
    function GetWidth: Integer;
    function GetWindowClass: string;
    function IsEnabled: Boolean;
    function IsUnicode: Boolean;
    function IsVisible: Boolean;
    function IsWindowValid: Boolean;
    function PostMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): Boolean;
    function SendMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): Integer;
    procedure BringToFront;
    procedure SetHeight(const Value: Integer);
    procedure SetText(const Value: string);
    procedure SetWidth(const Value: Integer);
    property AsControl: TControl read GetAsControl;
    property Enabled: Boolean read IsEnabled;
    property Handle: HWND read GetHandle;
    property Height: Integer read GetHeight write SetHeight;
    property Parent: IWindow read GetParent;
    property ProcessId: Cardinal read GetProcessId;
    property Text: string read GetText write SetText;
    property TextLen: Integer read GetTextLen;
    property ThreadId: Cardinal read GetThreadId;
    property Unicode: Boolean read IsUnicode;
    property Valid: Boolean read IsWindowValid;
    property Visible: Boolean read IsVisible;
    property Width: Integer read GetWidth write SetWidth;
    property WindowClass: string read GetWindowClass;
  end;

  IWindowAction = interface
    ['{8383E04C-F238-4505-94C2-B104A9467D0F}']
    procedure Execute(const AWindow: IWindow);
  end;

  TProcessMessagesProc = procedure of object;
  TWindowActionProc = reference to procedure(const AWindow: IWindow);

  IExceptionHandler = interface
    procedure HandleException(AExceptObject: TObject; AExceptAddr: Pointer);
  end;

  IFutureWindow = interface
    function ExecAction(const AAction: IWindowAction): IFutureWindow;
    function ExecProc(const AWindowActionProc: TWindowActionProc): IFutureWindow;
    function ExecCloseWindow(): IFutureWindow;
    function ExecPauseAction(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc): IFutureWindow;
    function ExecSendKey(AKey: Word): IFutureWindow;
    function GetDesciption: string;
    function SetExceptionHandler(const AHandler: IExceptionHandler): IFutureWindow;
    function TimedOut: Boolean;
    function WindowFound: Boolean;
    property Description: string read GetDesciption;
  end;

  TFutureWindows = class
    class function Expect(const AWindowClass: string; AWaitSeconds: Double =  DEFAULT_WAIT_TIME_SECS): IFutureWindow;
    class function ExpectChild(AParent: HWND; const AWindowClass: string; AWaitSeconds: Double = DEFAULT_WAIT_TIME_SECS): IFutureWindow;
    class function GetWindow(AHandle: THandle): IWindow;
  end;

  TWindowActions = class
    class function CreateCloseWindowAction(): IWindowAction;
    class function CreatePauseAction(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc): IWindowAction;
    class function CreateProcAction(const AWindowActionProc: TWindowActionProc): IWindowAction;
    class function CreateSendKeyAction(AKey: Word): IWindowAction;
  end;

  TAbstractWindowAction = class(TInterfacedObject, IWindowAction)
  protected
    procedure Execute(const AWindow: IWindow); virtual; abstract;
  end;

implementation
uses
  Messages;

type
  PControl = ^TControl;
  TWindow = class(TInterfacedObject, IWindow)
  strict private
    FWindowClass: string;
    FHandle: HWND;
    FProcessId: Cardinal;
    FThreadId: Cardinal;
    FControl: PControl;
    FParent: IWindow;
    procedure InitThreadIdAndProcessId;
    procedure SetWindowSize(AWidth, AHeight: Integer);
  private
    function GetAsControl: TControl;
    function GetHandle: HWND;
    function GetHeight: Integer;
    function GetParent: IWindow;
    function GetProcessId: Cardinal;
    function GetRect: TRect;
    function GetText: string;
    function GetTextLen: Integer;
    function GetThreadId: Cardinal;
    function GetWidth: Integer;
    function GetWindowClass: string;
    function IsEnabled: Boolean;
    function IsUnicode: Boolean;
    function IsVisible: Boolean;
    function IsWindowValid: Boolean;
    function PostMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): Boolean;
    function SendMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM): Integer;
    procedure BringToFront;
    procedure SetHeight(const Value: Integer);
    procedure SetText(const Value: string);
    procedure SetWidth(const Value: Integer);
  public
    constructor Create(AHandle: HWND);
    destructor Destroy; override;
    property AsControl: TControl read GetAsControl;
    property Enabled: Boolean read IsEnabled;
    property Handle: HWND read GetHandle;
    property Parent: IWindow read GetParent;
    property ProcessId: Cardinal read GetProcessId;
    property Text: string read GetText write SetText;
    property TextLen: Integer read GetTextLen;
    property ThreadId: Cardinal read GetThreadId;
    property Unicode: Boolean read IsUnicode;
    property Valid: Boolean read IsWindowValid;
    property Visible: Boolean read IsVisible;
    property WindowClass: string read GetWindowClass;
    property Width: Integer read GetWidth write SetWidth;
    property Height: Integer read GetHeight write SetHeight;
  end;

  TAbstractFutureWindow = class(TInterfacedObject, IFutureWindow)
  strict private
    FActions: IInterfaceList;
    FExecException: Exception;
    FExecExceptAddr: Pointer;
    FExceptionHandler: IExceptionHandler;
    function GetAction(AIndex: Integer): IWindowAction;
    function GetActionsCount: Integer;
    procedure CheckRaiseExecException;
    procedure TryCloseWindow(const AWindow: IWindow);
  protected
    function StartWaiting(): IFutureWindow; virtual; abstract;
    procedure ExecuteActions(const AWindow: IWindow);
  protected
    { IFutureWindow }
    function ExecAction(const AAction: IWindowAction): IFutureWindow;
    function ExecProc(const AWindowActionProc: TWindowActionProc): IFutureWindow;
    function ExecCloseWindow(): IFutureWindow;
    function ExecPauseAction(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc): IFutureWindow;
    function ExecSendKey(AKey: Word): IFutureWindow;
    function GetDesciption: string; virtual; abstract;
    function SetExceptionHandler(const AHandler: IExceptionHandler): IFutureWindow;
    function TimedOut: Boolean; virtual; abstract;
    function WindowFound: Boolean; virtual; abstract;
  public
    destructor Destroy; override;
  end;

//==============================================================================
// Non-threaded IFutureWindow implementation

  TWindowCallback = procedure(const AWindow: IWindow) of object;

  TWindowCallbackList = class
  strict private type
    PWindowCallback = ^TWindowCallback;
  strict private
    FItems: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function Find(ACallback: TWindowCallback; out AIndex: Integer): Boolean;
    function GetCount: Integer;
    function GetItem(AIndex: Integer): TWindowCallback;
    function Has(ACallback: TWindowCallback): Boolean;
    procedure Add(ACallback: TWindowCallback);
    procedure Clear;
    procedure Delete(AIndex: Integer);
    procedure Remove(ACallback: TWindowCallback);
  public
    property Count: Integer read GetCount;
    property Items[AIndex: Integer]: TWindowCallback read GetItem; default;
  end;

  TFutureWindowObserver = class
  strict private
    class var FInstance: TFutureWindowObserver;
    class function GetInstance: TFutureWindowObserver; static;
  strict private
    FCallbacks: TWindowCallbackList;
    FCallbacksToRemove: TWindowCallbackList;
    FCurrentProcessId: Cardinal;
    FHandle: THandle;
    FNotifying: Boolean;
    constructor Create;
    procedure CallCallbacks;
    procedure CallCallbacksForWindow(const AWindow: IWindow);
    procedure StartTimer;
    procedure StopTimer;
    procedure WndProc(var AMsg: TMessage);
  public
    destructor Destroy; override;
    procedure RegisterCallback(ACallback: TWindowCallback);
    procedure UnRegisterCallback(ACallback: TWindowCallback);
  public
    class procedure Finalize;
    class property Instance: TFutureWindowObserver read GetInstance;
  end;

  TFutureWindow = class(TAbstractFutureWindow)
  strict private
    FParentWnd: HWND;
    FTimedOut: Boolean;
    FWaitSecs: Double;
    FWindowClass: string;
    FWindowFound: Boolean;
    FStartedMillis: Cardinal;
  private
    { IFutureWindowEx }
    procedure CheckWindow(const AWindow: IWindow);
  protected
    function GetDesciption: string; override;
    function StartWaiting(): IFutureWindow; override;
    function TimedOut: Boolean; override;
    function WindowFound: Boolean; override;
  public
    constructor Create(AParent: HWND; const AWindowClass: string; AWaitSecs: Double);
    destructor Destroy; override;
  end;

//===================== ACTIONS ================================================
  TWindowActionProcAction = class(TAbstractWindowAction)
  strict private
    FProc: TWindowActionProc;
  protected
    procedure Execute(const AWindow: IWindow); override;
  public
    constructor Create(const AProc: TWindowActionProc);
  end;

  TSendKeyAction = class(TAbstractWindowAction)
  strict private
    FKey: Word;
  protected
    procedure Execute(const AWindow: IWindow); override;
  public
    constructor Create(AKey: Word);
  end;

  TCloseWindowAction = class(TAbstractWindowAction)
  protected
    procedure Execute(const AWindow: IWindow); override;
  end;

  TPauseAction = class(TAbstractWindowAction)
  strict private
    FSeconds: Double;
    FProcessMessagesProc: TProcessMessagesProc;
  protected
    procedure Execute(const AWindow: IWindow); override;
  public
    constructor Create(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc);
  end;

{$ifdef EnableLogging}
  procedure log(const AMsg: string);
  var
    msg: string;
  begin
    msg := Format('[FutureWindows][%.4d] %s', [GetCurrentThreadId, AMsg]);
    OutputDebugString(PChar(msg));
  end;
{$endif}

{ TFutureWindows }
class function TFutureWindows.Expect(const AWindowClass: string;
  AWaitSeconds: Double): IFutureWindow;
begin
  Result := ExpectChild(0, AWindowClass, AWaitSeconds)
end;

class function TFutureWindows.ExpectChild(AParent: HWND;
  const AWindowClass: string; AWaitSeconds: Double): IFutureWindow;
begin
  Result := TFutureWindow.Create(AParent, AWindowClass, AWaitSeconds);
end;

class function TFutureWindows.GetWindow(AHandle: THandle): IWindow;
begin
  Result := TWindow.Create(AHandle);
end;

{ TAbstractFutureWindow }
procedure TAbstractFutureWindow.CheckRaiseExecException;
var
  e: Exception;
begin
  if FExecException <> nil then
  begin
    e := FExecException;
    FExecException := nil;
    raise e at FExecExceptAddr;
  end;
end;

destructor TAbstractFutureWindow.Destroy;
begin
  FActions := nil;
  inherited;
  CheckRaiseExecException;
end;

function TAbstractFutureWindow.ExecAction(const AAction: IWindowAction): IFutureWindow;
begin
  if FActions = nil then
    FActions := TInterfaceList.Create;
  FActions.Add(AAction);
  Result := StartWaiting();
end;

function TAbstractFutureWindow.ExecProc(const AWindowActionProc: TWindowActionProc): IFutureWindow;
begin
  Result := ExecAction(TWindowActionProcAction.Create(AWindowActionProc));
end;

function TAbstractFutureWindow.ExecCloseWindow: IFutureWindow;
begin
  Result := ExecAction(TWindowActions.CreateCloseWindowAction());
end;

function TAbstractFutureWindow.ExecPauseAction(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc): IFutureWindow;
begin
  Result := ExecAction(TWindowActions.CreatePauseAction(ASeconds, AProcessMessagesProc));
end;

function TAbstractFutureWindow.ExecSendKey(AKey: Word): IFutureWindow;
begin
  Result := ExecAction(TWindowActions.CreateSendKeyAction(AKey))
end;

procedure TAbstractFutureWindow.ExecuteActions(const AWindow: IWindow);
var
  i: Integer;
begin
  Assert(AWindow <> nil);
  Assert(AWindow.Valid);
  {$ifdef EnableLogging}log('executing actions for: ' + GetDesciption);{$endif}
  try
    for i := 0 to GetActionsCount - 1 do
      GetAction(i).Execute(AWindow);
  except
    if  FExceptionHandler <>  nil then
      FExceptionHandler.HandleException(AcquireExceptionObject, ExceptAddr)
    else
    begin
      FExecExceptAddr := ExceptAddr;
      FExecException  := AcquireExceptionObject;
    end;
    TryCloseWindow(AWindow);
  end;
end;

function TAbstractFutureWindow.GetAction(AIndex: Integer): IWindowAction;
begin
  Result := FActions[AIndex] as IWindowAction;
end;

function TAbstractFutureWindow.GetActionsCount: Integer;
begin
  if FActions = nil then
    Result := 0
  else
    Result := FActions.Count;
end;

function TAbstractFutureWindow.SetExceptionHandler(const AHandler: IExceptionHandler): IFutureWindow;
begin
  FExceptionHandler := AHandler;
  Result := Self;
end;

procedure TAbstractFutureWindow.TryCloseWindow(const AWindow: IWindow);
begin
  TWindowActions.CreateCloseWindowAction().Execute(AWindow);
end;

{ TFutureWindowObserver }
procedure TFutureWindowObserver.CallCallbacks;
type
  PEnumProcParams = ^TEnumProcParams;
  TEnumProcParams = record
    current_process_id: Cardinal;
    windows_list: IInterfaceList;
  end;

  function enum_windows_proc(AHandle: HWND; AParam: LPARAM): Boolean; stdcall;
  var
    params: PEnumProcParams;
    w: IWindow;
  begin
    w := TFutureWindows.GetWindow(AHandle);
    params := PEnumProcParams(AParam);
    if (w.ProcessId = params^.current_process_id) and
       w.Visible and w.Enabled then
      params^.windows_list.Add(w);
    Result := True;
  end;

var
  i: Integer;
  params: TEnumProcParams;
  w: IWindow;
begin
  if FNotifying or (FCallbacks.Count = 0) then  Exit;

  {$ifdef EnableLogging}log(ToString + '.CallCallbacks');{$endif}

  FNotifying := True;
  try
    params.current_process_id := FCurrentProcessId;
    params.windows_list := TInterfaceList.Create;
    try
      EnumWindows(@enum_windows_proc, Integer(@params));
      for i := 0 to params.windows_list.Count - 1 do
      begin
        w := params.windows_list[i] as IWindow;
        CallCallbacksForWindow(w);
      end;
    finally
      params.windows_list := nil;
    end;
  finally
    FNotifying := False;
  end;

  for i := 0 to FCallbacksToRemove.Count - 1 do
    UnRegisterCallback(FCallbacksToRemove[i]);
  FCallbacksToRemove.Clear;
end;

procedure TFutureWindowObserver.CallCallbacksForWindow(const AWindow: IWindow);
var
  i: Integer;
  cb: TWindowCallback;
begin
  for i := FCallbacks.Count - 1 downto 0 do
  begin
    cb := FCallbacks[i];
    if (not FCallbacksToRemove.Has(cb))  then
      cb(AWindow)
  end;
end;

constructor TFutureWindowObserver.Create;
begin
  inherited Create;
  FCurrentProcessId := GetCurrentProcessId;
  FCallbacks := TWindowCallbackList.Create;
  FCallbacksToRemove := TWindowCallbackList.Create;
end;

destructor TFutureWindowObserver.Destroy;
begin
  StopTimer;
  FCallbacks.Free;;
  FCallbacksToRemove.Free;
  inherited;
end;

class procedure TFutureWindowObserver.Finalize;
begin
  FInstance.Free;
end;

class function TFutureWindowObserver.GetInstance: TFutureWindowObserver;
begin
  if FInstance = nil then
    FInstance := TFutureWindowObserver.Create;
  Result := FInstance;
end;

procedure TFutureWindowObserver.RegisterCallback(ACallback: TWindowCallback);
begin
  {$ifdef EnableLogging}log(ToString + '.RegisterCallback');{$endif}
  Assert(not FCallbacks.Has(ACallback));
  FCallbacks.Add(ACallback);
  if FCallbacks.Count = 1 then
    StartTimer;
end;

procedure TFutureWindowObserver.StartTimer;
begin
  if FHandle = 0 then
  begin
    {$ifdef EnableLogging}log(ToString + '.StartTimer');{$endif}
    FHandle := AllocateHWnd(WndProc);
    Windows.SetTimer(FHandle, 1, 50, nil);
  end;
end;

procedure TFutureWindowObserver.StopTimer;
begin
  if FHandle <> 0 then
  begin
    {$ifdef EnableLogging}log(ToString + '.StopTimer');{$endif}
    KillTimer(FHandle, 1);
    DeallocateHWnd(FHandle);
    FHandle := 0;
  end;
end;

procedure TFutureWindowObserver.UnRegisterCallback(ACallback: TWindowCallback);
begin
  {$ifdef EnableLogging}log(ToString + '.UnRegisterCallback');{$endif}
  if FNotifying then
    FCallbacksToRemove.Add(ACallback)
  else
  begin
    FCallbacks.Remove(ACallback);
    if FCallbacks.Count = 0 then
      StopTimer;
  end;
end;

procedure TFutureWindowObserver.WndProc(var AMsg: TMessage);
begin
  case AMsg.Msg of
    WM_TIMER:
      CallCallbacks();
  else
    DefWindowProc(FHandle, AMsg.Msg, AMsg.WParam, AMsg.LParam)
  end;
end;

{ TNonThreadedFutureWindow }
procedure TFutureWindow.CheckWindow(const AWindow: IWindow);
begin
  Assert(not FWindowFound);
  Assert(not FTimedOut);

  FWindowFound := ((FParentWnd = 0) or (AWindow.Parent.Handle = FParentWnd)) and
    (AWindow.WindowClass = FWindowClass);

  if not FWindowFound then
    FTimedOut := GetTickCount > (FStartedMillis + Round(FWaitSecs * 1000));

  if FWindowFound or FTimedOut then
    TFutureWindowObserver.Instance.UnRegisterCallback(CheckWindow);

  if FWindowFound then
    ExecuteActions(AWindow)
end;

constructor TFutureWindow.Create(AParent: HWND;
  const AWindowClass: string; AWaitSecs: Double);
begin
  inherited Create;
  FParentWnd := AParent;
  FWindowClass := AWindowClass;
  FWaitSecs := AWaitSecs;
end;

destructor TFutureWindow.Destroy;
begin
  {$ifdef EnableLogging}log(Self.ToString + '.Destroy');{$endif}
  TFutureWindowObserver.Instance.UnRegisterCallback(CheckWindow);

  // we might be raising en exception in inherited destructor so manually clean
  // as much as possible
  FWindowClass := '';

  inherited;
end;

function TFutureWindow.GetDesciption: string;
begin
  Result := FWindowClass;
end;

function TFutureWindow.StartWaiting: IFutureWindow;
begin
  if FStartedMillis = 0 then
  begin
    {$ifdef EnableLogging}log(ToString + '.StartWaiting');{$endif}
    FStartedMillis := GetTickCount;
    TFutureWindowObserver.Instance.RegisterCallback(CheckWindow);
  end;
  Result := Self;
end;

function TFutureWindow.TimedOut: Boolean;
begin
  Result := FTimedOut;
end;

function TFutureWindow.WindowFound: Boolean;
begin
  Result := FWindowFound;
end;

{ TSendVKeyAction }
constructor TSendKeyAction.Create(AKey: Word);
begin
  FKey := AKey
end;

procedure TSendKeyAction.Execute(const AWindow: IWindow);
begin
  AWindow.PostMessage(WM_KEYDOWN, FKey, 0);
  AWindow.PostMessage(WM_KEYUP, FKey, 0);
end;

{ TCloseWindowAction }
procedure TCloseWindowAction.Execute(const AWindow: IWindow);
begin
  AWindow.SendMessage(WM_CLOSE, 0, 0);
end;

{ TPauseAction }
constructor TPauseAction.Create(ASeconds: Double; AProcessMessagesProc: TProcessMessagesProc);
begin
  Assert(Assigned(AProcessMessagesProc));
  FSeconds := ASeconds;
  FProcessMessagesProc := AProcessMessagesProc;
end;

procedure TPauseAction.Execute(const AWindow: IWindow);
var
  now, finish: Cardinal;
begin
  if FSeconds = 0 then
    FProcessMessagesProc()
  else
  begin
    now := GetTickCount;
    finish := now + Round(FSeconds * 1000);
    while now < finish do
    begin
      FProcessMessagesProc();
      now := GetTickCount;
    end;
  end;
end;

{ TWindow }

procedure TWindow.BringToFront;
begin
  Windows.BringWindowToTop(FHandle)
end;

constructor TWindow.Create(AHandle: HWND);
begin
  FHandle := AHandle;
end;

destructor TWindow.Destroy;
begin
  Dispose(FControl);
  inherited;
end;

function TWindow.GetAsControl: TControl;
begin
  if FControl = nil then
  begin
    New(FControl);
    FControl^ := FindControl(FHandle)
  end;
  Result := FControl^
end;

function TWindow.GetHandle: HWND;
begin
  Result := FHandle
end;

function TWindow.GetHeight: Integer;
var
  r: TRect;
begin
  r := GetRect;
  Result := r.Bottom - r.Top
end;

function TWindow.GetParent: IWindow;
begin
  if FParent = nil then
    FParent := TFutureWindows.GetWindow(Windows.GetParent(FHandle));
  Result := FParent;
end;

function TWindow.GetProcessId: Cardinal;
begin
  InitThreadIdAndProcessId;
  Result := FProcessId;
end;

function TWindow.GetRect: TRect;
begin
  if not Windows.GetWindowRect(FHandle, Result) then
    Result := Rect(0, 0, 0, 0);
end;

function TWindow.GetText: string;
var
  len: Integer;
begin
  len := TextLen;
  SetString(Result, PChar(nil), len);
  if len > 0 then
    SendMessage(WM_GETTEXT, len + 1, Integer(PChar(Result)))
end;

function TWindow.GetTextLen: Integer;
begin
  Result := SendMessage(WM_GETTEXTLENGTH, 0, 0)
end;

function TWindow.GetThreadId: Cardinal;
begin
  InitThreadIdAndProcessId;
  Result := FThreadId;
end;

function TWindow.GetWidth: Integer;
var
  r: TRect;
begin
  r := GetRect;
  Result := r.Right - r.Left
end;

function TWindow.GetWindowClass: string;
var
  buffer: array[Byte] of Char;
begin
  if FWindowClass = '' then
  begin
    Windows.GetClassName(FHandle, @buffer, Length(buffer));
    FWindowClass := buffer;
  end;
  Result := FWindowClass;
end;

procedure TWindow.InitThreadIdAndProcessId;
begin
  if FThreadId = 0 then
    FThreadId := Windows.GetWindowThreadProcessId(FHandle, FProcessId)
end;

function TWindow.IsEnabled: Boolean;
begin
  Result := Windows.IsWindowEnabled(FHandle)
end;

function TWindow.IsUnicode: Boolean;
begin
  Result := Windows.IsWindowUnicode(FHandle)
end;

function TWindow.IsVisible: Boolean;
begin
  Result := Windows.IsWindowVisible(FHandle)
end;

function TWindow.IsWindowValid: Boolean;
begin
  Result := Windows.IsWindow(FHandle);
end;

function TWindow.PostMessage(Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): Boolean;
begin
  if IsUnicode then
    Result := Windows.PostMessageW(FHandle, Msg, wParam, lParam)
  else
    Result := Windows.PostMessageA(FHandle, Msg, wParam, lParam)
end;

function TWindow.SendMessage(Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): Integer;
begin
  if IsUnicode then
    Result := Windows.SendMessageW(FHandle, Msg, wParam, lParam)
  else
    Result := Windows.SendMessageA(FHandle, Msg, wParam, lParam)
end;

procedure TWindow.SetHeight(const Value: Integer);
begin
  SetWindowSize(Width, Value);
end;

procedure TWindow.SetText(const Value: string);
begin
  SendMessage(WM_SETTEXT, 0, Integer(PChar(Value)));
end;

procedure TWindow.SetWidth(const Value: Integer);
begin
  SetWindowSize(Value, Height);
end;

procedure TWindow.SetWindowSize(AWidth, AHeight: Integer);
begin
  Windows.SetWindowPos(FHandle, 0, 0, 0,
    AWidth, AHeight,
    SWP_NOZORDER or
    SWP_NOMOVE or
    SWP_NOACTIVATE
  )
end;

{ TWindowCallbackList }

procedure TWindowCallbackList.Add(ACallback: TWindowCallback);
var
  p: PWindowCallback;
begin
  if FItems = nil then
    FItems := TList.Create;

  New(p);
  p^ := ACallback;
  FItems.Add(p);
end;

procedure TWindowCallbackList.Clear;
var
  cnt: Integer;
begin
  cnt := GetCount;
  while cnt > 0 do
  begin
    Dec(cnt);
    Delete(cnt);
  end;
end;

constructor TWindowCallbackList.Create;
begin
  FItems := TList.Create;
end;

procedure TWindowCallbackList.Delete(AIndex: Integer);
var
  p: PWindowCallback;
begin
  p := FItems[AIndex];
  Dispose(p);
  FItems.Delete(AIndex);
end;

destructor TWindowCallbackList.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TWindowCallbackList.Find(ACallback: TWindowCallback;
  out AIndex: Integer): Boolean;
var
  p: PWindowCallback;
  method: TMethod;
begin
  AIndex := 0;
  method := TMethod(ACallback);
  while AIndex < GetCount  do
  begin
    p := FItems[AIndex];
    if CompareMem(p, @method, SizeOf(TWindowCallback)) then
      Exit(True);
    Inc(AIndex);
  end;
  AIndex := -1;
  Result := False;
end;

function TWindowCallbackList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TWindowCallbackList.GetItem(AIndex: Integer): TWindowCallback;
begin
  Result := PWindowCallback(FItems[AIndex])^
end;

function TWindowCallbackList.Has(ACallback: TWindowCallback): Boolean;
var
  dummy: Integer;
begin
  Result := Find(ACallback, dummy)
end;

procedure TWindowCallbackList.Remove(ACallback: TWindowCallback);
var
  idx: Integer;
begin
  if Find(ACallback, idx) then
    Delete(idx);
end;

{ TWindowActionProcAction }

constructor TWindowActionProcAction.Create(const AProc: TWindowActionProc);
begin
  FProc := AProc;
end;

procedure TWindowActionProcAction.Execute(const AWindow: IWindow);
begin
  FProc(AWindow);
end;

{ TWindowActions }

class function TWindowActions.CreateCloseWindowAction: IWindowAction;
begin
  Result := TCloseWindowAction.Create
end;

class function TWindowActions.CreatePauseAction(ASeconds: Double;
  AProcessMessagesProc: TProcessMessagesProc): IWindowAction;
begin
  Result := TPauseAction.Create(ASeconds, AProcessMessagesProc);
end;

class function TWindowActions.CreateProcAction(
  const AWindowActionProc: TWindowActionProc): IWindowAction;
begin
  Result := TWindowActionProcAction.Create(AWindowActionProc);
end;

class function TWindowActions.CreateSendKeyAction(AKey: Word): IWindowAction;
begin
  Result := TSendKeyAction.Create(AKey);
end;

initialization
finalization
  TFutureWindowObserver.Finalize;
end.