RnQ/RnQ/BaseWindow.pas

{
  This file is part of R&Q.
  Under same license
}
unit BaseWindow;
{$I RnQConfig.inc}

interface

uses
  Winapi.Windows, Winapi.Messages, System.Classes, System.SysUtils,
  SciterJSAPI, GlobalLib;

{$I NoRTTI.inc}

type
  TCustomWndProc = function (var Message: TMessage): Boolean of object;

  TBaseWindow = class
  private
    FElement: HELEMENT;
    FElements: TArray;
    FStyleAttr: WideString;
    FMyWndProc: TCustomWndProc;
  public
    Root: HELEMENT;
    Window: HWINDOW;
    OldWndProcPtr, WndProcPtr: Pointer;

    constructor Create;
    destructor Destroy; override;
    procedure InitWndProc; virtual;
    procedure CustomWndProc(var Message: TMessage);

    procedure Fire(const name: String; data: Variant);
    function Call(const FuncName: AnsiString; Params: TArray = []): Variant;
    function Select(const Selector: WideString): HELEMENT;
    function SelectAll(const Selector: WideString): TArray;
    function GetStyleAttr(Element: HELEMENT; const AttrName: WideString): WideString;
    function IsValid(Element: HELEMENT): Boolean;

    procedure Activate(BringToFront: Boolean = False);
    procedure UpdateTranslation;
    function GetWidth: Integer;
    function GetHeight: Integer;
    function GetVisible: Boolean;
    function GetCovered: Boolean;
    function GetBounds: TRect;
    procedure SetBounds(Rect: TFormDimen);
    procedure SetPosition(Left, Top: Integer);

    property Visible: Boolean read GetVisible;
    property Covered: Boolean read GetCovered;
    property MyWndProc: TCustomWndProc read FMyWndProc write FMyWndProc;
  end;

implementation

uses
  System.Variants, SciterLib;

constructor TBaseWindow.Create;
begin
  inherited Create;
  WndProcPtr := nil;
  OldWndProcPtr := nil;
end;

destructor TBaseWindow.Destroy;
begin
  if Assigned(OldWndProcPtr) then
    SetWindowLongPtr(Window, GWL_WNDPROC, NativeInt(OldWndProcPtr));
  inherited Destroy;
end;

procedure TBaseWindow.InitWndProc;
begin
  WndProcPtr := MakeObjectInstance(CustomWndProc);
  OldWndProcPtr := Pointer(SetWindowLongPtr(Window, GWL_WNDPROC, NativeInt(WndProcPtr)));
end;

procedure TBaseWindow.CustomWndProc(var Message: TMessage);
begin
  if Assigned(FMyWndProc) then
    if FMyWndProc(Message) then
      Exit;
  Message.Result := CallWindowProc(OldWndProcPtr, Window, Message.Msg, Message.WParam, Message.LParam);
end;

function TBaseWindow.Call(const FuncName: AnsiString; Params: TArray = []): Variant;
begin
  Result := UI.CallOnElement(Root, FuncName, Params);
end;

procedure TBaseWindow.Fire(const name: String; data: Variant);
begin
  UI.FireOnElement(Root, name, data);
end;

procedure TBaseWindow.Activate(BringToFront: Boolean = False);
begin
  Call('activate', [BringToFront]);
end;

procedure TBaseWindow.UpdateTranslation;
begin
  Call('updateTranslation');
end;

function TBaseWindow.GetBounds: TRect;
var
  Rect: Variant;
begin
  Rect := Call('getBounds');
  Result.Left := Rect[0];
  Result.Top := Rect[1];
  Result.Width := Rect[2];
  Result.Height := Rect[3];
end;

procedure TBaseWindow.SetBounds(Rect: TFormDimen);
begin
  if (Rect.Width > 0) and (Rect.Height > 0) then
    Call('setBounds', [Rect.Left, Rect.Top, Rect.Width, Rect.Height]);
end;

procedure TBaseWindow.SetPosition(Left, Top: Integer);
begin
  Call('setPosition', [Left, Top]);
end;

function TBaseWindow.GetWidth: Integer;
var
  Rect: TRect;
begin
  API.SciterGetElementLocation(Root, Rect, BORDER_BOX);
  Result := Rect.Width;
end;

function TBaseWindow.GetHeight: Integer;
var
  Rect: TRect;
begin
  API.SciterGetElementLocation(Root, Rect, BORDER_BOX);
  Result := Rect.Height;
end;

function TBaseWindow.GetVisible: Boolean;
begin
  Result := IsWindowVisible(Window);
end;

function TBaseWindow.GetCovered: Boolean;
var
  MyRect: TRect;
  MyRgn, TempRgn: HRGN;
  RType: Integer;
  HW: HWND;
begin
  GetWindowRect(Window, MyRect);
  MyRgn := CreateRectRgnIndirect(MyRect);
  HW := GetTopWindow(0);
  RType := SIMPLEREGION;

  while (HW <> 0) and (HW <> Window) and (RType <> NULLREGION) do
  begin
    if IsWindowVisible(HW) then
    begin
      GetWindowRect(HW, MyRect);
      TempRgn := CreateRectRgnIndirect(MyRect);
      RType := CombineRgn(MyRgn, MyRgn, TempRgn, RGN_DIFF);
      DeleteObject(TempRgn);
    end;
    if RType <> NULLREGION then
      HW := GetNextWindow(HW, GW_HWNDNEXT);
  end;
  DeleteObject(MyRgn);
  Result := (RType = NULLREGION) or (RType = COMPLEXREGION);
end;

function SelectSingleCallback(he: HELEMENT; Param: Pointer): BOOL; stdcall;
begin
  TBaseWindow(Param).FElement := he;
  Result := True; // Stop at first element
end;

function TBaseWindow.Select(const Selector: WideString): HELEMENT;
begin
  Result := nil;
  FElement := nil;
  API.SciterSelectElementsW(Root, PWideChar(Selector), PSciterElementCallback(@SelectSingleCallback), Self);
  Result := FElement;
end;

function SelectAllCallback(he: HELEMENT; Param: Pointer): BOOL; stdcall;
var
  BaseWindow: TBaseWindow;
begin
  BaseWindow := Param;
  BaseWindow.FElements := BaseWindow.FElements + [he];
  Result := False; // Continue
end;

function TBaseWindow.SelectAll(const Selector: WideString): TArray;
begin
  SetLength(Result, 0);
  SetLength(FElements, 0);
  API.SciterSelectElementsW(Root, PWideChar(Selector), PSciterElementCallback(@SelectAllCallback), Self);
  Result := FElements;
end;

procedure StyleAttributeTextCallback(str: PWideChar; str_length: UINT; param: Pointer); stdcall;
var
  BaseWindow: TBaseWindow;
begin
  BaseWindow := Param;
  if (str = nil) or (str_length = 0) then
    BaseWindow.FStyleAttr := ''
  else
    BaseWindow.FStyleAttr := WideString(str);
end;

function TBaseWindow.GetStyleAttr(Element: HELEMENT; const AttrName: WideString): WideString;
begin
  FStyleAttr := '';
  API.SciterGetStyleAttributeCB(Element, PAnsiChar(AnsiString(AttrName)), PLPCWSTR_RECEIVER(@StyleAttributeTextCallback), Self);
  Result := FStyleAttr;
end;

function TBaseWindow.IsValid(Element: HELEMENT): Boolean;
var
  Win: HWINDOW;
begin
  Result := True;
  if Element = nil then
    Result := False;
  if not (API.SciterGetElementHwnd(Element, Win, True) = SCDOM_OK) then
    Result := False;
  if Win = 0 then
    Result := False;
end;

end.