Added a new option to the DOMVisitor context menu and new option to the config button to the MiniBrowser demo

- The DOMVisitor demo now has a context menu option to copy the HTML inside the body element to the clipboard.
- The MiniBrowser demo now has a config button option to load local HTML files using a DATA url.
This commit is contained in:
Salvador Díaz Fau 2018-04-27 17:42:03 +02:00
parent 004744cfc4
commit d4dd717f51
3 changed files with 124 additions and 30 deletions

View File

@ -53,12 +53,16 @@ uses
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants; uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants;
const const
MINIBROWSER_VISITDOM = WM_APP + $101; MINIBROWSER_VISITDOM_PARTIAL = WM_APP + $101;
MINIBROWSER_VISITDOM_FULL = WM_APP + $102;
MINIBROWSER_CONTEXTMENU_VISITDOM = MENU_ID_USER_FIRST + 1; MINIBROWSER_CONTEXTMENU_VISITDOM_PARTIAL = MENU_ID_USER_FIRST + 1;
MINIBROWSER_CONTEXTMENU_VISITDOM_FULL = MENU_ID_USER_FIRST + 2;
DOMVISITOR_MSGNAME = 'domvisitor'; DOMVISITOR_MSGNAME_PARTIAL = 'domvisitorpartial';
RETRIEVEDOM_MSGNAME = 'retrievedom'; DOMVISITOR_MSGNAME_FULL = 'domvisitorfull';
RETRIEVEDOM_MSGNAME_PARTIAL = 'retrievedompartial';
RETRIEVEDOM_MSGNAME_FULL = 'retrievedomfull';
type type
TDOMVisitorFrm = class(TForm) TDOMVisitorFrm = class(TForm)
@ -109,7 +113,8 @@ type
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED; procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY; procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
procedure VisitDOMMsg(var aMessage : TMessage); message MINIBROWSER_VISITDOM; procedure VisitDOMMsg(var aMessage : TMessage); message MINIBROWSER_VISITDOM_PARTIAL;
procedure VisitDOM2Msg(var aMessage : TMessage); message MINIBROWSER_VISITDOM_FULL;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE; procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING; procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
@ -234,13 +239,25 @@ begin
SimpleNodeSearch(document); SimpleNodeSearch(document);
// Sending back some custom results to the browser process // Sending back some custom results to the browser process
// Notice that the DOMVISITOR_MSGNAME message name needs to be recognized in // Notice that the DOMVISITOR_MSGNAME_PARTIAL message name needs to be recognized in
// Chromium1ProcessMessageReceived // Chromium1ProcessMessageReceived
msg := TCefProcessMessageRef.New(DOMVISITOR_MSGNAME); msg := TCefProcessMessageRef.New(DOMVISITOR_MSGNAME_PARTIAL);
msg.ArgumentList.SetString(0, 'document.Title : ' + document.Title); msg.ArgumentList.SetString(0, 'document.Title : ' + document.Title);
browser.SendProcessMessage(PID_BROWSER, msg); browser.SendProcessMessage(PID_BROWSER, msg);
end; end;
procedure DOMVisitor_OnDocAvailableFullMarkup(const browser: ICefBrowser; const document: ICefDomDocument);
var
msg: ICefProcessMessage;
begin
// Sending back some custom results to the browser process
// Notice that the DOMVISITOR_MSGNAME_FULL message name needs to be recognized in
// Chromium1ProcessMessageReceived
msg := TCefProcessMessageRef.New(DOMVISITOR_MSGNAME_FULL);
msg.ArgumentList.SetString(0, document.Body.AsMarkup);
browser.SendProcessMessage(PID_BROWSER, msg);
end;
procedure GlobalCEFApp_OnProcessMessageReceived(const browser : ICefBrowser; procedure GlobalCEFApp_OnProcessMessageReceived(const browser : ICefBrowser;
sourceProcess : TCefProcessId; sourceProcess : TCefProcessId;
const message : ICefProcessMessage; const message : ICefProcessMessage;
@ -249,7 +266,11 @@ var
TempFrame : ICefFrame; TempFrame : ICefFrame;
TempVisitor : TCefFastDomVisitor2; TempVisitor : TCefFastDomVisitor2;
begin begin
if (browser <> nil) and (message.name = RETRIEVEDOM_MSGNAME) then aHandled := False;
if (browser <> nil) then
begin
if (message.name = RETRIEVEDOM_MSGNAME_PARTIAL) then
begin begin
TempFrame := browser.MainFrame; TempFrame := browser.MainFrame;
@ -262,7 +283,19 @@ begin
aHandled := True; aHandled := True;
end end
else else
aHandled := False; if (message.name = RETRIEVEDOM_MSGNAME_FULL) then
begin
TempFrame := browser.MainFrame;
if (TempFrame <> nil) then
begin
TempVisitor := TCefFastDomVisitor2.Create(browser, DOMVisitor_OnDocAvailableFullMarkup);
TempFrame.VisitDom(TempVisitor);
end;
aHandled := True;
end;
end;
end; end;
procedure TDOMVisitorFrm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser); procedure TDOMVisitorFrm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
@ -281,7 +314,8 @@ procedure TDOMVisitorFrm.Chromium1BeforeContextMenu(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel); const params: ICefContextMenuParams; const model: ICefMenuModel);
begin begin
model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM, 'Visit DOM in CEF'); model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM_PARTIAL, 'Visit DOM in CEF (only Title)');
model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM_FULL, 'Visit DOM in CEF (BODY HTML)');
end; end;
procedure TDOMVisitorFrm.Chromium1BeforePopup(Sender: TObject; procedure TDOMVisitorFrm.Chromium1BeforePopup(Sender: TObject;
@ -311,8 +345,11 @@ begin
Result := False; Result := False;
case commandId of case commandId of
MINIBROWSER_CONTEXTMENU_VISITDOM : MINIBROWSER_CONTEXTMENU_VISITDOM_PARTIAL :
PostMessage(Handle, MINIBROWSER_VISITDOM, 0, 0); PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL, 0, 0);
MINIBROWSER_CONTEXTMENU_VISITDOM_FULL :
PostMessage(Handle, MINIBROWSER_VISITDOM_FULL, 0, 0);
end; end;
end; end;
@ -324,11 +361,19 @@ begin
if (message = nil) or (message.ArgumentList = nil) then exit; if (message = nil) or (message.ArgumentList = nil) then exit;
if (message.Name = DOMVISITOR_MSGNAME) then
begin
// Message received from the DOMVISITOR in CEF // Message received from the DOMVISITOR in CEF
if (message.Name = DOMVISITOR_MSGNAME_PARTIAL) then
begin
ShowStatusText('DOM Visitor result text : ' + message.ArgumentList.GetString(0)); ShowStatusText('DOM Visitor result text : ' + message.ArgumentList.GetString(0));
Result := True; Result := True;
end
else
if (message.Name = DOMVISITOR_MSGNAME_FULL) then
begin
Clipboard.AsText := message.ArgumentList.GetString(0);
ShowStatusText('HTML copied to the clipboard');
Result := True;
end; end;
end; end;
@ -377,7 +422,7 @@ end;
procedure TDOMVisitorFrm.VisitDOMBtnClick(Sender: TObject); procedure TDOMVisitorFrm.VisitDOMBtnClick(Sender: TObject);
begin begin
PostMessage(Handle, MINIBROWSER_VISITDOM, 0, 0); PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL, 0, 0);
end; end;
procedure TDOMVisitorFrm.VisitDOMMsg(var aMessage : TMessage); procedure TDOMVisitorFrm.VisitDOMMsg(var aMessage : TMessage);
@ -385,7 +430,16 @@ var
TempMsg : ICefProcessMessage; TempMsg : ICefProcessMessage;
begin begin
// Use the ArgumentList property if you need to pass some parameters. // Use the ArgumentList property if you need to pass some parameters.
TempMsg := TCefProcessMessageRef.New(RETRIEVEDOM_MSGNAME); // Same name than TCefCustomRenderProcessHandler.MessageName TempMsg := TCefProcessMessageRef.New(RETRIEVEDOM_MSGNAME_PARTIAL); // Same name than TCefCustomRenderProcessHandler.MessageName
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end;
procedure TDOMVisitorFrm.VisitDOM2Msg(var aMessage : TMessage);
var
TempMsg : ICefProcessMessage;
begin
// Use the ArgumentList property if you need to pass some parameters.
TempMsg := TCefProcessMessageRef.New(RETRIEVEDOM_MSGNAME_FULL); // Same name than TCefCustomRenderProcessHandler.MessageName
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg); Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end; end;

View File

@ -286,9 +286,13 @@ object MiniBrowserFrm: TMiniBrowserFrm
Caption = '-' Caption = '-'
end end
object Openfile1: TMenuItem object Openfile1: TMenuItem
Caption = 'Open file...' Caption = 'Open file with a FILE URL...'
OnClick = Openfile1Click OnClick = Openfile1Click
end end
object OpenfilewithaDAT1: TMenuItem
Caption = 'Open file with a DATA URL...'
OnClick = OpenfilewithaDAT1Click
end
object N2: TMenuItem object N2: TMenuItem
Caption = '-' Caption = '-'
end end

View File

@ -114,6 +114,7 @@ type
Openfile1: TMenuItem; Openfile1: TMenuItem;
Resolvehost1: TMenuItem; Resolvehost1: TMenuItem;
Timer1: TTimer; Timer1: TTimer;
OpenfilewithaDAT1: TMenuItem;
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure BackBtnClick(Sender: TObject); procedure BackBtnClick(Sender: TObject);
procedure ForwardBtnClick(Sender: TObject); procedure ForwardBtnClick(Sender: TObject);
@ -193,6 +194,7 @@ type
procedure Chromium1RenderCompMsg(var aMessage : TMessage; var aHandled: Boolean); procedure Chromium1RenderCompMsg(var aMessage : TMessage; var aHandled: Boolean);
procedure Chromium1LoadingProgressChange(Sender: TObject; procedure Chromium1LoadingProgressChange(Sender: TObject;
const browser: ICefBrowser; const progress: Double); const browser: ICefBrowser; const progress: Double);
procedure OpenfilewithaDAT1Click(Sender: TObject);
protected protected
FResponse : TStringList; FResponse : TStringList;
@ -242,7 +244,7 @@ implementation
{$R *.dfm} {$R *.dfm}
uses uses
uPreferences, uCefStringMultimap, uSimpleTextViewer; uPreferences, uCefStringMultimap, uCEFMiscFunctions, uSimpleTextViewer;
// Destruction steps // Destruction steps
// ================= // =================
@ -860,8 +862,42 @@ end;
procedure TMiniBrowserFrm.Openfile1Click(Sender: TObject); procedure TMiniBrowserFrm.Openfile1Click(Sender: TObject);
begin begin
OpenDialog1.Filter := 'Any file (*.*)|*.*';
if OpenDialog1.Execute then
begin
// This is a quick solution to load files. The file URL should be properly encoded. // This is a quick solution to load files. The file URL should be properly encoded.
if OpenDialog1.Execute then Chromium1.LoadURL('file:///' + OpenDialog1.FileName); Chromium1.LoadURL('file:///' + OpenDialog1.FileName);
end;
end;
procedure TMiniBrowserFrm.OpenfilewithaDAT1Click(Sender: TObject);
var
TempDATA : string;
TempFile : TMemoryStream;
begin
TempFile := nil;
try
try
OpenDialog1.Filter := 'HTML files (*.html)|*.HTML;*.HTM';
if OpenDialog1.Execute then
begin
// Use TByteStream instead of TMemoryStream if your Delphi version supports it.
TempFile := TMemoryStream.Create;
TempFile.LoadFromFile(OpenDialog1.FileName);
TempDATA := 'data:text/html;charset=utf-8;base64,' + CefBase64Encode(TempFile.Memory, TempFile.Size);
Chromium1.LoadURL(TempDATA);
end;
except
on e : exception do
if CustomExceptionHandler('TMiniBrowserFrm.OpenfilewithaDAT1Click', e) then raise;
end;
finally
if (TempFile <> nil) then FreeAndNil(TempFile);
end;
end; end;
procedure TMiniBrowserFrm.PopupMenu1Popup(Sender: TObject); procedure TMiniBrowserFrm.PopupMenu1Popup(Sender: TObject);