CEF4Delphi/demos/Lazarus_any_OS/BrowserWindowDom/uHelperProcessDom.pas

162 lines
4.6 KiB
ObjectPascal
Raw Normal View History

2021-03-04 01:44:02 +01:00
// ************************************************************************
// ***************************** 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 © 2021 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 = 'MSG_REQUEST_DOM';
MSG_RESPONSE_DOM = 'MSG_RESPONSE_DOM';
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); // Same name than TCefCustomRenderProcessHandler.MessageName
if foundNode <> nil then
TempMsg.ArgumentList.SetString(0, foundNode.AsMarkup)
else
TempMsg.ArgumentList.SetString(0, 'Not Found');
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: 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.