mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-15 15:55:56 +01:00
ca8bc9dff4
Added the PDS file to extract the HTML Help files using PasDoc Added more XML documentation Fixed some XML errors. Removed the license copy from the pas units. Updated the LICENSE.md file
399 lines
12 KiB
ObjectPascal
399 lines
12 KiB
ObjectPascal
unit uCEFChromium;
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE OBJFPC}{$H+}
|
|
{$ENDIF}
|
|
|
|
{$I cef.inc}
|
|
|
|
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
|
|
{$MINENUMSIZE 4}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DELPHI16_UP}
|
|
{$IFDEF MSWINDOWS}WinApi.Windows,{$ENDIF} System.Classes, Vcl.Controls, Vcl.Graphics, Vcl.Forms,
|
|
{$ELSE}
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, Controls, Graphics, Forms,
|
|
{$IFDEF FPC}
|
|
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase,
|
|
{$ELSE}
|
|
Messages,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
uCEFConstants, uCEFTypes, uCEFInterfaces, uCEFChromiumCore;
|
|
|
|
type
|
|
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pfidWindows)]{$ENDIF}{$ENDIF}
|
|
/// <summary>
|
|
/// VCL and LCL version of TChromiumCore that puts together all browser procedures, functions, properties and events in one place.
|
|
/// It has all you need to create, modify and destroy a web browser.
|
|
/// </summary>
|
|
TChromium = class(TChromiumCore)
|
|
protected
|
|
function GetParentFormHandle : TCefWindowHandle; override;
|
|
function GetParentForm : TCustomForm;
|
|
procedure InitializeDevToolsWindowInfo(aDevTools : TWinControl); virtual;
|
|
public
|
|
{$IFDEF MSWINDOWS}
|
|
/// <summary>
|
|
/// Used with browsers in OSR mode to initialize drag and drop in Windows.
|
|
/// </summary>
|
|
procedure InitializeDragAndDrop(const aDropTargetCtrl : TWinControl);
|
|
{$ENDIF MSWINDOWS}
|
|
/// <summary>
|
|
/// Open developer tools (DevTools) in its own browser. If inspectElementAt has a valid point
|
|
/// with coordinates different than low(integer) then the element at the specified location
|
|
/// will be inspected. If the DevTools browser is already open then it will be focused.
|
|
/// </summary>
|
|
procedure ShowDevTools(inspectElementAt: TPoint; const aDevTools : TWinControl = nil);
|
|
/// <summary>
|
|
/// Close the developer tools.
|
|
/// </summary>
|
|
procedure CloseDevTools(const aDevTools : TWinControl = nil);
|
|
/// <summary>
|
|
/// Move the parent form to the x and y coordinates.
|
|
/// </summary>
|
|
procedure MoveFormTo(const x, y: Integer);
|
|
/// <summary>
|
|
/// Move the parent form adding x and y to the coordinates.
|
|
/// </summary>
|
|
procedure MoveFormBy(const x, y: Integer);
|
|
/// <summary>
|
|
/// Add x to the parent form width.
|
|
/// </summary>
|
|
procedure ResizeFormWidthTo(const x : Integer);
|
|
/// <summary>
|
|
/// Add y to the parent form height.
|
|
/// </summary>
|
|
procedure ResizeFormHeightTo(const y : Integer);
|
|
/// <summary>
|
|
/// Set the parent form left property to x.
|
|
/// </summary>
|
|
procedure SetFormLeftTo(const x : Integer);
|
|
/// <summary>
|
|
/// Set the parent form top property to y.
|
|
/// </summary>
|
|
procedure SetFormTopTo(const y : Integer);
|
|
/// <summary>
|
|
/// Used to create the browser after the global request context has been
|
|
/// initialized. You need to set all properties and events before calling
|
|
/// this function because it will only create the internal handlers needed
|
|
/// for those events and the property values will be used in the browser
|
|
/// initialization.
|
|
/// The browser will be fully initialized when the TChromiumCore.OnAfterCreated
|
|
/// event is triggered.
|
|
/// </summary>
|
|
function CreateBrowser(const aBrowserParent : TWinControl = nil; const aWindowName : ustring = ''; const aContext : ICefRequestContext = nil; const aExtraInfo : ICefDictionaryValue = nil) : boolean; overload; virtual;
|
|
/// Copy the DC to a bitmap stream. Only works on Windows with browsers without GPU acceleration.
|
|
/// It's recommended to use the "Page.captureScreenshot" DevTools method instead.
|
|
/// </summary>
|
|
function SaveAsBitmapStream(const aStream : TStream) : boolean;
|
|
/// <summary>
|
|
/// Copy the DC to a TBitmap. Only works on Windows with browsers without GPU acceleration.
|
|
/// It's recommended to use the "Page.captureScreenshot" DevTools method instead.
|
|
/// </summary>
|
|
function TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
{$ENDIF}
|
|
|
|
// *********************************************************
|
|
// ********************** ATTENTION ! **********************
|
|
// *********************************************************
|
|
// ** **
|
|
// ** MANY OF THE EVENTS IN CEF4DELPHI COMPONENTS LIKE **
|
|
// ** TCHROMIUM, TFMXCHROMIUM OR TCEFAPPLICATION ARE **
|
|
// ** EXECUTED IN A CEF THREAD BY DEFAULT. **
|
|
// ** **
|
|
// ** WINDOWS CONTROLS MUST BE CREATED AND DESTROYED IN **
|
|
// ** THE SAME THREAD TO AVOID ERRORS. **
|
|
// ** SOME OF THEM RECREATE THE HANDLERS IF THEY ARE **
|
|
// ** MODIFIED AND CAN CAUSE THE SAME ERRORS. **
|
|
// ** **
|
|
// ** DON'T CREATE, MODIFY OR DESTROY WINDOWS CONTROLS **
|
|
// ** INSIDE THE CEF4DELPHI EVENTS AND USE **
|
|
// ** SYNCHRONIZATION OBJECTS TO PROTECT VARIABLES AND **
|
|
// ** FIELDS IF THEY ARE ALSO USED IN THE MAIN THREAD. **
|
|
// ** **
|
|
// ** READ THIS FOR MORE INFORMATION : **
|
|
// ** https://www.briskbard.com/index.php?pageid=cef **
|
|
// ** **
|
|
// ** USE OUR FORUMS FOR MORE QUESTIONS : **
|
|
// ** https://www.briskbard.com/forum/ **
|
|
// ** **
|
|
// *********************************************************
|
|
// *********************************************************
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DELPHI16_UP}
|
|
System.SysUtils, System.Math,
|
|
{$ELSE}
|
|
SysUtils, Math,
|
|
{$ENDIF}
|
|
uCEFMiscFunctions;
|
|
|
|
{ TChromium }
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
procedure TChromium.InitializeDragAndDrop(const aDropTargetCtrl: TWinControl);
|
|
begin
|
|
if (aDropTargetCtrl <> nil) then
|
|
inherited InitializeDragAndDrop(aDropTargetCtrl.Handle);
|
|
end;
|
|
{$ENDIF MSWINDOWS}
|
|
|
|
procedure TChromium.InitializeDevToolsWindowInfo(aDevTools: TWinControl);
|
|
var
|
|
TempHandle : TCefWindowHandle;
|
|
begin
|
|
if (aDevTools <> nil) then
|
|
DefaultInitializeDevToolsWindowInfo(aDevTools.Handle, aDevTools.ClientRect, aDevTools.Name)
|
|
else
|
|
begin
|
|
InitializeWindowHandle(TempHandle);
|
|
DefaultInitializeDevToolsWindowInfo(TempHandle, Rect(0, 0, 0, 0), '');
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.ShowDevTools(inspectElementAt: TPoint; const aDevTools : TWinControl);
|
|
begin
|
|
if Initialized then
|
|
begin
|
|
InitializeDevToolsWindowInfo(aDevTools);
|
|
inherited ShowDevTools(inspectElementAt, @FDevWindowInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.CloseDevTools(const aDevTools : TWinControl);
|
|
begin
|
|
if Initialized then
|
|
begin
|
|
if (aDevTools <> nil) then
|
|
inherited CloseDevTools(aDevTools.Handle)
|
|
else
|
|
inherited CloseDevTools(0);
|
|
end;
|
|
end;
|
|
|
|
function TChromium.GetParentForm : TCustomForm;
|
|
var
|
|
TempComp : TComponent;
|
|
begin
|
|
Result := nil;
|
|
TempComp := Owner;
|
|
|
|
while (TempComp <> nil) do
|
|
if (TempComp is TCustomForm) then
|
|
begin
|
|
Result := TCustomForm(TempComp);
|
|
exit;
|
|
end
|
|
else
|
|
TempComp := TempComp.owner;
|
|
end;
|
|
|
|
function TChromium.GetParentFormHandle : TCefWindowHandle;
|
|
var
|
|
TempForm : TCustomForm;
|
|
begin
|
|
Result := inherited GetParentFormHandle;
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) and TempForm.HandleAllocated then
|
|
Result := TempForm.Handle
|
|
else
|
|
if (Application <> nil) and
|
|
(Application.MainForm <> nil) and
|
|
Application.MainForm.HandleAllocated then
|
|
Result := Application.MainForm.Handle;
|
|
end;
|
|
|
|
procedure TChromium.MoveFormTo(const x, y: Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
TempRect : TRect;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
begin
|
|
TempRect.Left := min(max(x, max(screen.DesktopLeft, 0)), screen.DesktopWidth - TempForm.Width);
|
|
TempRect.Top := min(max(y, max(screen.DesktopTop, 0)), screen.DesktopHeight - TempForm.Height);
|
|
TempRect.Right := TempRect.Left + TempForm.Width - 1;
|
|
TempRect.Bottom := TempRect.Top + TempForm.Height - 1;
|
|
|
|
TempForm.SetBounds(TempRect.Left, TempRect.Top, TempRect.Right - TempRect.Left + 1, TempRect.Bottom - TempRect.Top + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.MoveFormBy(const x, y: Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
TempRect : TRect;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
begin
|
|
TempRect.Left := min(max(TempForm.Left + x, max(screen.DesktopLeft, 0)), screen.DesktopWidth - TempForm.Width);
|
|
TempRect.Top := min(max(TempForm.Top + y, max(screen.DesktopTop, 0)), screen.DesktopHeight - TempForm.Height);
|
|
TempRect.Right := TempRect.Left + TempForm.Width - 1;
|
|
TempRect.Bottom := TempRect.Top + TempForm.Height - 1;
|
|
|
|
TempForm.SetBounds(TempRect.Left, TempRect.Top, TempRect.Right - TempRect.Left + 1, TempRect.Bottom - TempRect.Top + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.ResizeFormWidthTo(const x : Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
TempX, TempDeltaX : integer;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
begin
|
|
TempX := max(x, 100);
|
|
TempDeltaX := TempForm.Width - TempForm.ClientWidth;
|
|
TempForm.Width := TempX + TempDeltaX;
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.ResizeFormHeightTo(const y : Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
TempY, TempDeltaY : integer;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
begin
|
|
TempY := max(y, 100);
|
|
TempDeltaY := TempForm.Height - TempForm.ClientHeight;
|
|
TempForm.Height := TempY + TempDeltaY;
|
|
end;
|
|
end;
|
|
|
|
procedure TChromium.SetFormLeftTo(const x : Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
TempForm.Left := min(max(x, max(screen.DesktopLeft, 0)), screen.DesktopWidth - TempForm.Width);
|
|
end;
|
|
|
|
procedure TChromium.SetFormTopTo(const y : Integer);
|
|
var
|
|
TempForm : TCustomForm;
|
|
begin
|
|
TempForm := GetParentForm;
|
|
|
|
if (TempForm <> nil) then
|
|
TempForm.Top := min(max(y, max(screen.DesktopTop, 0)), screen.DesktopHeight - TempForm.Height);
|
|
end;
|
|
|
|
function TChromium.CreateBrowser(const aBrowserParent : TWinControl;
|
|
const aWindowName : ustring;
|
|
const aContext : ICefRequestContext;
|
|
const aExtraInfo : ICefDictionaryValue) : boolean;
|
|
var
|
|
TempHandle : TCefWindowHandle;
|
|
TempRect : TRect;
|
|
begin
|
|
if (aBrowserParent <> nil) then
|
|
begin
|
|
TempHandle := aBrowserParent.Handle;
|
|
TempRect := aBrowserParent.ClientRect;
|
|
end
|
|
else
|
|
begin
|
|
InitializeWindowHandle(TempHandle);
|
|
TempRect := rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
Result := inherited CreateBrowser(TempHandle, TempRect, aWindowName, aContext, aExtraInfo);
|
|
end;
|
|
|
|
function TChromium.SaveAsBitmapStream(const aStream : TStream) : boolean;
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
TempDC : HDC;
|
|
TempRect : TRect;
|
|
{$ENDIF}
|
|
begin
|
|
Result := False;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
if not(FIsOSR) and (FRenderCompHWND <> 0) and (aStream <> nil) then
|
|
begin
|
|
TempDC := GetDC(FRenderCompHWND);
|
|
|
|
if (TempDC <> 0) then
|
|
try
|
|
GetClientRect(FRenderCompHWND, TempRect);
|
|
Result := CopyDCToBitmapStream(TempDC, TempRect, aStream);
|
|
finally
|
|
ReleaseDC(FRenderCompHWND, TempDC);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TChromium.TakeSnapshot(var aBitmap : TBitmap) : boolean;
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
TempDC : HDC;
|
|
TempRect : TRect;
|
|
TempWidth : Integer;
|
|
TempHeight : Integer;
|
|
{$ENDIF}
|
|
begin
|
|
Result := False;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
if not(FIsOSR) and (FRenderCompHWND <> 0) then
|
|
begin
|
|
GetClientRect(FRenderCompHWND, TempRect);
|
|
|
|
TempWidth := TempRect.Right - TempRect.Left;
|
|
TempHeight := TempRect.Bottom - TempRect.Top;
|
|
|
|
if (TempWidth <= 0) or (TempHeight <= 0) then exit;
|
|
|
|
if (aBitmap <> nil) then FreeAndNil(aBitmap);
|
|
|
|
aBitmap := TBitmap.Create;
|
|
aBitmap.Height := TempHeight;
|
|
aBitmap.Width := TempWidth;
|
|
|
|
TempDC := GetDC(FRenderCompHWND);
|
|
|
|
if (TempDC <> 0) then
|
|
try
|
|
Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight,
|
|
TempDC, 0, 0, SRCCOPY);
|
|
finally
|
|
ReleaseDC(FRenderCompHWND, TempDC);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
{$I res/tchromium.lrs}
|
|
RegisterComponents('Chromium', [TChromium]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
end.
|