Delphi/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-15 15:55:56 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Update to CEF 3.3202.1684.gd665578

Browse Source 
- Removed the Graphics32 dependency in SimpleOSRBrowser demo. Now this demo uses a custom component called TBufferPanel included in CEF4Delphi.
- Now SimpleOSRBrowser demo draws the "select" elements.
- Fixed a bug in SimpleOSRBrowser with high DPI monitors. The new paint function works with all client sizes.
This commit is contained in:
Salvador Díaz Fau 2017-11-16 12:49:15 +01:00
parent 28a5827e3e
commit ac54a086f4
21 changed files with 569 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
demos/CookieVisitor/uCookieVisitor.pas
View File

@ -168,7 +168,8 @@ end;
procedure TCookieVisitorFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TCookieVisitorFrm.GoBtnClick(Sender: TObject);

3
demos/CustomResourceBrowser/uMainForm.pas
View File

@ -103,7 +103,8 @@ end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(ChromiumWindow1.CreateBrowser) then Timer1.Enabled := True;
if not(ChromiumWindow1.CreateBrowser) and not(ChromiumWindow1.Initialized) then
Timer1.Enabled := True;
end;
procedure TMainForm.Chromium_OnAfterCreated(Sender: TObject);

3
demos/DOMVisitor/uDOMVisitor.pas
View File

@ -199,7 +199,8 @@ end;
procedure TDOMVisitorFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
end.

3
demos/FullScreenBrowser/uMainForm.pas
View File

@ -107,7 +107,8 @@ end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TMainForm.HandleKeyDown(const aMsg : TMsg; var aHandled : boolean);

3
demos/Geolocation/uGeolocation.pas
View File

@ -117,7 +117,8 @@ end;
procedure TGeolocationFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TGeolocationFrm.WMMove(var aMessage : TWMMove);

3
demos/JSEval/uJSEval.pas
View File

@ -217,7 +217,8 @@ end;
procedure TJSEvalFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TJSEvalFrm.WMMove(var aMessage : TWMMove);

3
demos/JSExtension/uJSExtension.pas
View File

@ -238,7 +238,8 @@ end;
procedure TJSExtensionFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TJSExtensionFrm.BrowserCreatedMsg(var aMessage : TMessage);

3
demos/MiniBrowser/uMiniBrowser.pas
View File

@ -614,7 +614,8 @@ end;
procedure TMiniBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TMiniBrowserFrm.BrowserCreatedMsg(var aMessage : TMessage);

3
demos/PostDataInspector/uPostDataInspector.pas
View File

@ -139,7 +139,8 @@ end;
procedure TPostDataInspectorFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TPostDataInspectorFrm.WMMove(var aMessage : TWMMove);

3
demos/SchemeRegistrationBrowser/uSchemeRegistrationBrowser.pas
View File

@ -156,7 +156,8 @@ end;
procedure TSchemeRegistrationBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TSchemeRegistrationBrowserFrm.BrowserCreatedMsg(var aMessage : TMessage);

4
demos/SimpleBrowser/uSimpleBrowser.dfm
View File

@ -65,7 +65,7 @@ object Form1: TForm1
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 552
Top = 264
Left = 56
Top = 88
end
end

3
demos/SimpleBrowser/uSimpleBrowser.pas
View File

@ -119,7 +119,8 @@ end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(ChromiumWindow1.CreateBrowser) then Timer1.Enabled := True;
if not(ChromiumWindow1.CreateBrowser) and not(ChromiumWindow1.Initialized) then
Timer1.Enabled := True;
end;
procedure TForm1.WMMove(var aMessage : TWMMove);

38
demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm
View File

@ -1,7 +1,7 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Simple OSR Browser'
Caption = 'Simple OSR Browser - Initializing browser. Please wait...'
ClientHeight = 510
ClientWidth = 800
Color = clBtnFace
@ -13,6 +13,7 @@ object Form1: TForm1
OldCreateOrder = False
Position = poScreenCenter
OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
OnCreate = FormCreate
OnDestroy = FormDestroy
OnHide = FormHide
OnShow = FormShow
@ -31,7 +32,7 @@ object Form1: TForm1
Padding.Right = 5
Padding.Bottom = 5
ShowCaption = False
TabOrder = 1
TabOrder = 0
object ComboBox1: TComboBox
Left = 5
Top = 5
@ -44,7 +45,10 @@ object Form1: TForm1
OnEnter = ComboBox1Enter
Items.Strings = (
'https://www.google.com'
'https://html5demos.com/drag')
'https://html5demos.com/drag'
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_selec' +
't_form')
end
object Panel2: TPanel
Left = 726
@ -95,32 +99,22 @@ object Form1: TForm1
end
end
end
object Panel1: TPanel
object Panel1: TBufferPanel
Left = 0
Top = 30
Width = 800
Height = 480
Align = alClient
BevelOuter = bvNone
ShowCaption = False
TabOrder = 0
TabStop = True
Caption = 'Panel1'
TabOrder = 1
OnClick = Panel1Click
OnEnter = Panel1Enter
OnExit = Panel1Exit
object PaintBox: TPaintBox32
Left = 0
Top = 0
Width = 800
Height = 480
Align = alClient
TabOrder = 0
OnClick = PaintBoxClick
OnMouseDown = PaintBoxMouseDown
OnMouseMove = PaintBoxMouseMove
OnMouseUp = PaintBoxMouseUp
OnMouseLeave = PaintBoxMouseLeave
OnResize = PaintBoxResize
end
OnMouseDown = Panel1MouseDown
OnMouseLeave = Panel1MouseLeave
OnMouseMove = Panel1MouseMove
OnMouseUp = Panel1MouseUp
OnResize = Panel1Resize
end
object chrmosr: TChromium
OnAfterCreated = chrmosrAfterCreated

245
demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas
View File

@ -44,49 +44,47 @@ interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.AppEvnts,
System.SyncObjs, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Vcl.ExtCtrls, Vcl.AppEvnts,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes,
Windows, Messages, SysUtils, Variants, Classes, SyncObjs,
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts,
{$ENDIF}
GR32_Image, // You need the Graphics32 components for this demo available at http://graphics32.org and https://github.com/graphics32/graphics32
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants;
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uBufferPanel;
type
TForm1 = class(TForm)
NavControlPnl: TPanel;
chrmosr: TChromium;
AppEvents: TApplicationEvents;
Panel1: TPanel; // This is just a quick and dirty hack to receive some events that the PaintBox can't receive.
PaintBox: TPaintBox32;
ComboBox1: TComboBox;
Panel2: TPanel;
GoBtn: TButton;
SnapshotBtn: TButton;
SaveDialog1: TSaveDialog;
Timer1: TTimer;
Panel1: TBufferPanel;
procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
procedure GoBtnClick(Sender: TObject);
procedure SnapshotBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure GoBtnEnter(Sender: TObject);
procedure Panel1Enter(Sender: TObject);
procedure Panel1Exit(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseLeave(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);
procedure PaintBoxClick(Sender: TObject);
procedure PaintBoxResize(Sender: TObject);
procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PaintBoxMouseLeave(Sender: TObject);
procedure chrmosrPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor: HICON; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo);
procedure chrmosrGetViewRect(Sender: TObject; const browser: ICefBrowser; var rect: TCefRect; out Result: Boolean);
@ -95,9 +93,17 @@ type
procedure chrmosrPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
procedure chrmosrPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
procedure chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure GoBtnEnter(Sender: TObject);
procedure SnapshotBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject);
procedure ComboBox1Enter(Sender: TObject); private
procedure ComboBox1Enter(Sender: TObject);
protected
FPopUpBitmap : TBitmap;
FPopUpRect : TRect;
FShowPopUp : boolean;
function getModifiers(Shift: TShiftState): TCefEventFlags;
function GetButton(Button: TMouseButton): TCefMouseButtonType;
@ -119,6 +125,11 @@ implementation
{$R *.dfm}
uses
{$IFDEF DELPHI16_UP}
System.Math,
{$ELSE}
Math,
{$ENDIF}
uCEFMiscFunctions, uCEFApplication;
procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
@ -223,8 +234,6 @@ begin
Handled := True;
end;
// The MouseWheel event in PaintBox doesn't receive any event
// so we'll catch the WM_MOUSEWHEEL message here.
WM_MOUSEWHEEL :
if Panel1.Focused and (GlobalCEFApp <> nil) then
begin
@ -258,12 +267,13 @@ procedure TForm1.chrmosrCursorChange(Sender : TObject;
cursorType : TCefCursorType;
const customCursorInfo : PCefCursorInfo);
begin
PaintBox.Cursor := GefCursorToWindowsCursor(cursorType);
Panel1.Cursor := GefCursorToWindowsCursor(cursorType);
end;
procedure TForm1.chrmosrGetScreenInfo(Sender: TObject;
const browser: ICefBrowser; var screenInfo: TCefScreenInfo;
out Result: Boolean);
procedure TForm1.chrmosrGetScreenInfo(Sender : TObject;
const browser : ICefBrowser;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
begin
@ -271,8 +281,8 @@ begin
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(PaintBox.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(PaintBox.Height, GlobalCEFApp.DeviceScaleFactor);
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
@ -301,7 +311,7 @@ begin
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := PaintBox.ClientToScreen(TempViewPt);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
@ -319,8 +329,8 @@ begin
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(PaintBox.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(PaintBox.Height, GlobalCEFApp.DeviceScaleFactor);
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
Result := True;
end
else
@ -337,64 +347,117 @@ procedure TForm1.chrmosrPaint(Sender : TObject;
height : Integer);
var
src, dst: PByte;
offset, i, j, w: Integer;
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride, DstStride : Integer;
n : NativeUInt;
TempWidth, TempHeight, TempScanlineSize : integer;
TempBufferBits : Pointer;
begin
if (width <> PaintBox.Width) or (height <> PaintBox.Height) then Exit;
// ====================
// === WARNING !!!! ===
// ====================
// This is a simple and basic function that copies the buffer passed from
// CEF into the PaintBox canvas. If you have a high DPI monitor you may
// have rounding problems resulting in a black screen.
// CEF and this demo use a device_scale_factor to calculate screen logical
// and real sizes. If there's a rounding error CEF and this demo will have
// slightly different sizes and this function will exit.
// If you need to support high DPI, you'll have to use a better function
// to copy the buffer.
with PaintBox.Buffer do
if Panel1.BeginBufferDraw then
begin
PaintBox.Canvas.Lock;
Lock;
try
for j := 0 to dirtyRectsCount - 1 do
if (kind = PET_POPUP) then
begin
w := Width * 4;
offset := ((dirtyRects[j].y * Width) + dirtyRects[j].x) * 4;
src := @PByte(buffer)[offset];
dst := @PByte(Bits)[offset];
offset := dirtyRects[j].width * 4;
for i := 0 to dirtyRects[j].height - 1 do
begin
Move(src^, dst^, offset);
Inc(dst, w);
Inc(src, w);
end;
PaintBox.Flush(Rect(dirtyRects[j].x, dirtyRects[j].y,
dirtyRects[j].x + dirtyRects[j].width, dirtyRects[j].y + dirtyRects[j].height));
if (FPopUpBitmap = nil) or
(width <> FPopUpBitmap.Width) or
(height <> FPopUpBitmap.Height) then
begin
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
FPopUpBitmap := TBitmap.Create;
FPopUpBitmap.PixelFormat := pf32bit;
FPopUpBitmap.HandleType := bmDIB;
FPopUpBitmap.Width := width;
FPopUpBitmap.Height := height;
end;
TempWidth := FPopUpBitmap.Width;
TempHeight := FPopUpBitmap.Height;
TempScanlineSize := FPopUpBitmap.Width * SizeOf(TRGBQuad);
TempBufferBits := FPopUpBitmap.Scanline[pred(FPopUpBitmap.Height)];
end
else
begin
TempWidth := Panel1.BufferWidth;
TempHeight := Panel1.BufferHeight;
TempScanlineSize := Panel1.ScanlineSize;
TempBufferBits := Panel1.BufferBits;
end;
finally
Unlock;
PaintBox.Canvas.Unlock;
end;
if (TempBufferBits <> nil) then
begin
SrcStride := Width * SizeOf(TRGBQuad);
DstStride := - TempScanlineSize;
n := 0;
while (n < dirtyRectsCount) do
begin
if (dirtyRects[n].x >= 0) and (dirtyRects[n].y >= 0) then
begin
TempLineSize := min(dirtyRects[n].width, TempWidth - dirtyRects[n].x) * SizeOf(TRGBQuad);
if (TempLineSize > 0) then
begin
TempSrcOffset := ((dirtyRects[n].y * Width) + dirtyRects[n].x) * SizeOf(TRGBQuad);
TempDstOffset := ((TempScanlineSize * pred(TempHeight)) - (dirtyRects[n].y * TempScanlineSize)) +
(dirtyRects[n].x * SizeOf(TRGBQuad));
src := @PByte(buffer)[TempSrcOffset];
dst := @PByte(TempBufferBits)[TempDstOffset];
i := 0;
j := min(dirtyRects[n].height, TempHeight - dirtyRects[n].y);
while (i < j) do
begin
Move(src^, dst^, TempLineSize);
Inc(dst, DstStride);
Inc(src, SrcStride);
inc(i);
end;
end;
end;
inc(n);
end;
if FShowPopup and (FPopUpBitmap <> nil) then
Panel1.BufferDraw(FPopUpRect.Left, FPopUpRect.Top, FPopUpBitmap);
end;
Panel1.EndBufferDraw;
Panel1.InvalidatePanel;
end;
end;
procedure TForm1.chrmosrPopupShow(Sender : TObject;
const browser : ICefBrowser;
show : Boolean);
show : Boolean);
begin
// TO DO : Needed to draw the "select" items
if show then
FShowPopUp := True
else
begin
FShowPopUp := False;
FPopUpRect := rect(0, 0, 0, 0);
if (chrmosr <> nil) then chrmosr.Invalidate(PET_VIEW);
end;
end;
procedure TForm1.chrmosrPopupSize(Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
// TO DO : Needed to draw the "select" items
// The rect also needs to be converted.
// LogicalToDevice(rect, GlobalCEFApp.DeviceScaleFactor);
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
end;
procedure TForm1.ComboBox1Enter(Sender: TObject);
@ -467,9 +530,18 @@ begin
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
FShowPopUp := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
chrmosr.ShutdownDragAndDrop;
if (FPopUpBitmap <> nil) then FreeAndNil(FPopUpBitmap);
end;
procedure TForm1.FormHide(Sender: TObject);
@ -487,22 +559,22 @@ begin
end
else
begin
Caption := 'Simple OSR Browser - Initializing browser. Please wait...';
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF); // opaque white background color
// opaque white background color
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
if chrmosr.CreateBrowser(nil, '') then
chrmosr.InitializeDragAndDrop(PaintBox)
chrmosr.InitializeDragAndDrop(Panel1)
else
Timer1.Enabled := True;
end;
end;
procedure TForm1.PaintBoxClick(Sender: TObject);
procedure TForm1.Panel1Click(Sender: TObject);
begin
Panel1.SetFocus;
end;
procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
@ -516,7 +588,7 @@ begin
end;
end;
procedure TForm1.PaintBoxMouseLeave(Sender: TObject);
procedure TForm1.Panel1MouseLeave(Sender: TObject);
var
TempEvent : TCefMouseEvent;
TempPoint : TPoint;
@ -524,16 +596,16 @@ begin
if (GlobalCEFApp <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := PaintBox.ScreenToclient(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, not PaintBox.MouseInControl);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
end;
procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
@ -543,11 +615,11 @@ begin
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, not PaintBox.MouseInControl);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
end;
procedure TForm1.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
@ -561,9 +633,8 @@ begin
end;
end;
procedure TForm1.PaintBoxResize(Sender: TObject);
procedure TForm1.Panel1Resize(Sender: TObject);
begin
PaintBox.Buffer.SetSize(PaintBox.Width, PaintBox.Height);
chrmosr.WasResized;
end;
@ -579,7 +650,7 @@ end;
procedure TForm1.SnapshotBtnClick(Sender: TObject);
begin
if SaveDialog1.Execute then PaintBox.Buffer.SaveToFile(SaveDialog1.FileName);
if SaveDialog1.Execute then Panel1.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.SnapshotBtnEnter(Sender: TObject);
@ -592,9 +663,9 @@ begin
Timer1.Enabled := False;
if chrmosr.CreateBrowser(nil, '') then
chrmosr.InitializeDragAndDrop(PaintBox)
chrmosr.InitializeDragAndDrop(Panel1)
else
Timer1.Enabled := True;
if not(chrmosr.Initialized) then Timer1.Enabled := True;
end;
end.

3
demos/SubProcess/uSimpleBrowser.pas
View File

@ -119,7 +119,8 @@ end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(ChromiumWindow1.CreateBrowser) then Timer1.Enabled := True;
if not(ChromiumWindow1.CreateBrowser) and not(ChromiumWindow1.Initialized) then
Timer1.Enabled := True;
end;
procedure TForm1.WMMove(var aMessage : TWMMove);

3
source/CEF4Delphi.dpk
View File

@ -156,6 +156,7 @@ contains
uCEFDragAndDropMgr in 'uCEFDragAndDropMgr.pas',
uCEFGetExtensionResourceCallback in 'uCEFGetExtensionResourceCallback.pas',
uCEFExtension in 'uCEFExtension.pas',
uCEFExtensionHandler in 'uCEFExtensionHandler.pas';
uCEFExtensionHandler in 'uCEFExtensionHandler.pas',
uBufferPanel in 'uBufferPanel.pas';
end.

7
source/CEF4Delphi.dproj
View File

@ -220,6 +220,7 @@
<DCCReference Include="uCEFGetExtensionResourceCallback.pas"/>
<DCCReference Include="uCEFExtension.pas"/>
<DCCReference Include="uCEFExtensionHandler.pas"/>
<DCCReference Include="uBufferPanel.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -250,6 +251,12 @@
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule"/>
<DeployFile LocalName="..\..\..\..\..\..\..\Public\Documents\Embarcadero\Studio\17.0\Bpl\CEF4Delphi.bpl" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule"/>
<DeployFile LocalName="..\..\..\..\..\..\..\Public\Documents\Embarcadero\Studio\19.0\Bpl\CEF4Delphi.bpl" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>CEF4Delphi.bpl</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">

3
source/CEF4Delphi_D7.dpk
View File

@ -153,6 +153,7 @@ contains
uOLEDragAndDrop in 'uOLEDragAndDrop.pas',
uCEFGetExtensionResourceCallback in 'uCEFGetExtensionResourceCallback.pas',
uCEFExtension in 'uCEFExtension.pas',
uCEFExtensionHandler in 'uCEFExtensionHandler.pas';
uCEFExtensionHandler in 'uCEFExtensionHandler.pas',
uBufferPanel in 'uBufferPanel.pas';
end.

354
source/uBufferPanel.pas Normal file
View File

@ -0,0 +1,354 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2017 Salvador Díaz 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 uBufferPanel;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.Classes, Vcl.ExtCtrls, Vcl.Controls,
Vcl.Graphics, System.SyncObjs, System.SysUtils;
{$ELSE}
Windows, Messages, Classes, Controls,
ExtCtrls, Graphics, SyncObjs, SysUtils;
{$ENDIF}
type
TBufferPanel = class(TCustomPanel)
protected
FMutex : THandle;
FBuffer : TBitmap;
FScanlineSize : integer;
function GetBufferBits : pointer;
function GetBufferWidth : integer;
function GetBufferHeight : integer;
procedure CopyBuffer(aDC : HDC; const aRect : TRect);
function SaveBufferToFile(const aFilename : string) : boolean;
procedure DestroyBuffer;
procedure Resize; override;
procedure WMPaint(var aMessage: TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var aMessage : TWMEraseBkgnd); message WM_ERASEBKGND;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AfterConstruction; override;
function SaveToFile(const aFilename : string) : boolean;
procedure InvalidatePanel;
function BeginBufferDraw : boolean;
procedure EndBufferDraw;
procedure BufferDraw(x, y : integer; const aBitmap : TBitmap);
property Buffer : TBitmap read FBuffer;
property ScanlineSize : integer read FScanlineSize;
property BufferWidth : integer read GetBufferWidth;
property BufferHeight : integer read GetBufferHeight;
property BufferBits : pointer read GetBufferBits;
property DockManager;
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderWidth;
property BorderStyle;
property Caption;
property Color;
property Constraints;
property Ctl3D;
property UseDockManager default True;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FullRepaint;
property Font;
property Locked;
property ParentBiDiMode;
property ParentBackground;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
{$IFDEF DELPHI9_UP}
property ShowCaption;
property VerticalAlignment;
property OnAlignInsertBefore;
property OnAlignPosition;
{$ENDIF}
{$IFDEF DELPHI10_UP}
property Padding;
property OnMouseActivate;
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
{$IFDEF DELPHI12_UP}
property ParentDoubleBuffered;
{$ENDIF}
{$IFDEF DELPHI14_UP}
property Touch;
property OnGesture;
{$ENDIF}
{$IFDEF DELPHI17_UP}
property StyleElements;
{$ENDIF}
end;
implementation
uses
uCEFMiscFunctions;
constructor TBufferPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMutex := 0;
FBuffer := nil;
end;
destructor TBufferPanel.Destroy;
begin
DestroyBuffer;
if (FMutex <> 0) then
begin
CloseHandle(FMutex);
FMutex := 0;
end;
inherited Destroy;
end;
procedure TBufferPanel.AfterConstruction;
begin
inherited AfterConstruction;
FMutex := CreateMutex(nil, False, nil);
end;
procedure TBufferPanel.DestroyBuffer;
begin
if BeginBufferDraw then
begin
if (FBuffer <> nil) then FreeAndNil(FBuffer);
EndBufferDraw;
end;
end;
function TBufferPanel.SaveBufferToFile(const aFilename : string) : boolean;
begin
Result := False;
try
if (FBuffer <> nil) then
begin
FBuffer.SaveToFile(aFilename);
Result := True;
end;
except
on e : exception do
if CustomExceptionHandler('TBufferPanel.SaveBufferToFile', e) then raise;
end;
end;
function TBufferPanel.SaveToFile(const aFilename : string) : boolean;
begin
if BeginBufferDraw then
begin
Result := SaveBufferToFile(aFilename);
EndBufferDraw;
end
else
Result := False;
end;
procedure TBufferPanel.InvalidatePanel;
begin
PostMessage(Handle, CM_INVALIDATE, 0, 0);
end;
function TBufferPanel.BeginBufferDraw : boolean;
begin
Result := (FMutex <> 0) and (WaitForSingleObject(FMutex, 5000) = WAIT_OBJECT_0);
end;
procedure TBufferPanel.EndBufferDraw;
begin
if (FMutex <> 0) then ReleaseMutex(FMutex);
end;
procedure TBufferPanel.CopyBuffer(aDC : HDC; const aRect : TRect);
begin
if BeginBufferDraw then
begin
if (FBuffer <> nil) and (aDC <> 0) then
BitBlt(aDC, aRect.Left, aRect.Top, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top,
FBuffer.Canvas.Handle, aRect.Left, aRect.Top,
SrcCopy);
EndBufferDraw;
end;
end;
procedure TBufferPanel.WMPaint(var aMessage: TWMPaint);
var
TempPaintStruct: TPaintStruct;
TempDC : HDC;
begin
try
TempDC := BeginPaint(Handle, TempPaintStruct);
if csDesigning in ComponentState then
begin
Canvas.Font.Assign(Font);
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Style := psDash;
Canvas.Rectangle(0, 0, Width, Height);
end
else
CopyBuffer(TempDC, TempPaintStruct.rcPaint);
finally
EndPaint(Handle, TempPaintStruct);
aMessage.Result := 1;
end;
end;
procedure TBufferPanel.Resize;
begin
if BeginBufferDraw then
begin
if ((FBuffer = nil) or
(FBuffer.Width <> Width) or
(FBuffer.Height <> Height)) then
begin
if (FBuffer <> nil) then FreeAndNil(FBuffer);
FBuffer := TBitmap.Create;
FBuffer.PixelFormat := pf32bit;
FBuffer.HandleType := bmDIB;
FBuffer.Width := Width;
FBuffer.Height := Height;
FScanlineSize := FBuffer.Width * SizeOf(TRGBQuad);
end;
EndBufferDraw;
end;
inherited Resize;
end;
procedure TBufferPanel.WMEraseBkgnd(var aMessage : TWMEraseBkgnd);
begin
aMessage.Result := 1;
end;
function TBufferPanel.GetBufferBits : pointer;
begin
if (FBuffer <> nil) then
Result := FBuffer.Scanline[pred(FBuffer.Height)]
else
Result := nil;
end;
function TBufferPanel.GetBufferWidth : integer;
begin
if (FBuffer <> nil) then
Result := FBuffer.Width
else
Result := 0;
end;
function TBufferPanel.GetBufferHeight : integer;
begin
if (FBuffer <> nil) then
Result := FBuffer.Height
else
Result := 0;
end;
procedure TBufferPanel.BufferDraw(x, y : integer; const aBitmap : TBitmap);
begin
if (FBuffer <> nil) then FBuffer.Canvas.Draw(x, y, aBitmap);
end;
end.

4
source/uCEFApplication.pas
View File

@ -57,13 +57,13 @@ uses
const
CEF_SUPPORTED_VERSION_MAJOR = 3;
CEF_SUPPORTED_VERSION_MINOR = 3202;
CEF_SUPPORTED_VERSION_RELEASE = 1683;
CEF_SUPPORTED_VERSION_RELEASE = 1686;
CEF_SUPPORTED_VERSION_BUILD = 0;
CEF_CHROMEELF_VERSION_MAJOR = 62;
CEF_CHROMEELF_VERSION_MINOR = 0;
CEF_CHROMEELF_VERSION_RELEASE = 3202;
CEF_CHROMEELF_VERSION_BUILD = 89;
CEF_CHROMEELF_VERSION_BUILD = 94;
LIBCEF_DLL = 'libcef.dll';
CHROMEELF_DLL = 'chrome_elf.dll';

4
source/uCEFRegisterComponents.pas
View File

@ -53,11 +53,11 @@ uses
{$ELSE}
Classes,
{$ENDIF}
uCEFChromium, uCEFWindowParent, uCEFChromiumWindow;
uCEFChromium, uCEFWindowParent, uCEFChromiumWindow, uBufferPanel;
procedure Register;
begin
RegisterComponents('Chromium', [TChromium, TCEFWindowParent, TChromiumWindow]);
RegisterComponents('Chromium', [TChromium, TCEFWindowParent, TChromiumWindow, TBufferPanel]);
end;
end.