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,
  GlobalLib, Sciter, SciterApi;

{$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;

    procedure InitWndProc; virtual;
    procedure CustomWndProc(var Message: TMessage);

    procedure Fire(cmd: UINT);
    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);
    function GetWidth: Integer;
    function GetHeight: Integer;
    function GetVisible: Boolean;
    function GetBounds: TRect;
    procedure SetBounds(Rect: TFormDimen);
    procedure SetPosition(Left, Top: Integer);

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

implementation

uses
  System.Variants, RQUtil, SciterLib;

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(MyWndProc) then
    if MyWndProc(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(cmd: UINT);
begin
  UI.FireOnElement(Root, cmd, Null);
end;

procedure TBaseWindow.Activate(BringToFront: Boolean = False);
begin
  Call('activate', [BringToFront]);
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 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;
  SetLength(BaseWindow.FElements, Length(BaseWindow.FElements) + 1);
  BaseWindow.FElements[Length(BaseWindow.FElements) - 1] := 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(FElement, 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.