CEF4Delphi/demos/Lazarus_any_OS/BrowserWindowOsrDom/uHelperProcessDom.pas

// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
//         https://www.briskbard.com/index.php?lang=en&pageid=cef
//
//        Copyright © 2022 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
 *                       Delphi Chromium Embedded 3
 *
 * Usage allowed under the restrictions of the Lesser GNU General Public License
 * or alternatively the restrictions of the Mozilla Public License 1.1
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 * the specific language governing rights and limitations under the License.
 *
 * Unit owner : Henri Gourvest <hgourvest@gmail.com>
 * Web site   : http://www.progdigy.com
 * Repository : http://code.google.com/p/delphichromiumembedded/
 * Group      : http://groups.google.com/group/delphichromiumembedded
 *
 * Embarcadero Technologies, Inc is not permitted to use or redistribute
 * this source code without explicit permission.
 *
 *)

unit uHelperProcessDom;

(* The code in this unit is executed in the renderer sub-process
*)

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, uCEFApplication, uCEFInterfaces, uCEFDomVisitor, uCEFTypes,
  uCEFProcessMessage;

const
  MSG_REQUEST_DOM_R = 'MSG_REQUEST_DOM_R';
  MSG_RESPONSE_DOM_R = 'MSG_RESPONSE_DOM_R';

procedure InitProcessMessagesHandler;

implementation

type

  { TDomVisitorFindXY }

  TDomVisitorFindXY = class(TCefDomVisitorOwn)
    protected
      FFrame   : ICefFrame;
      FX, FY: Integer;
      procedure visit(const document: ICefDomDocument); override;
    public
      constructor Create(AFrame: ICefFrame; X,Y: Integer); reintroduce; virtual;
  end;


{ TDomVisitorFindXY }

procedure TDomVisitorFindXY.visit(const document: ICefDomDocument);
var
  node, foundNode: ICefDomNode;
  nb: TCefRect;
  TempMsg : ICefProcessMessage;
begin
  node := document.GetBody;
  foundNode := nil;
  if node <> nil then
    begin
      nb := node.GetElementBounds;
      if (FX >= nb.x) and (FX < nb.x + nb.width) and
         (FY >= nb.y) and (FY < nb.y + nb.height)
      then
        begin
          while node <> nil do
            begin
              foundNode := node;
              if node.HasChildren then
                begin
                  node := node.FirstChild;
                  while node <> nil do
                    begin
                      nb := node.GetElementBounds;
                      if (FX >= nb.x) and (FX < nb.x + nb.width) and
                         (FY >= nb.y) and (FY < nb.y + nb.height)
                      then
                        break  // go outer loop
                      else
                        node := node.NextSibling;
                    end;
                end
                else
                  node := nil;
            end;
        end;
    end;

  TempMsg := TCefProcessMessageRef.New(MSG_RESPONSE_DOM_R); // Same name than TCefCustomRenderProcessHandler.MessageName
  if foundNode <> nil then begin
    nb := foundNode.GetElementBounds;
    TempMsg.ArgumentList.SetInt(0, nb.X);
    TempMsg.ArgumentList.SetInt(1, nb.y);
    TempMsg.ArgumentList.SetInt(2, nb.width);
    TempMsg.ArgumentList.SetInt(3, nb.height);
  end
  else begin
    TempMsg.ArgumentList.SetInt(0, 0);
    TempMsg.ArgumentList.SetInt(1, 0);
    TempMsg.ArgumentList.SetInt(2, 0);
    TempMsg.ArgumentList.SetInt(3, 0);
  end;
  if (FFrame <> nil) and FFrame.IsValid then
    FFrame.SendProcessMessage(PID_BROWSER, TempMsg);
end;

constructor TDomVisitorFindXY.Create(AFrame: ICefFrame; X, Y: Integer);
begin
  FFrame := AFrame;
  FX := X;
  FY := Y;
  inherited Create;
end;


procedure DoProcessMessageReceived(const browser: ICefBrowser;
  const frame: ICefFrame; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage; var aHandled: boolean);
var
  TempVisitor : TDomVisitorFindXY;
begin
  aHandled := False;
  case message.Name of
    MSG_REQUEST_DOM_R: begin
      if (frame <> nil) and frame.IsValid then
        begin
          TempVisitor := TDomVisitorFindXY.Create(
            frame,
            message.ArgumentList.GetInt(0),
            message.ArgumentList.GetInt(1)
          );
          frame.VisitDom(TempVisitor);
        end;
      aHandled := True;

    end;
  end;
end;

procedure InitProcessMessagesHandler;
begin
  GlobalCEFApp.OnProcessMessageReceived := @DoProcessMessageReceived;
end;

end.