diff --git a/demos/CookieVisitor/uCookieVisitor.pas b/demos/CookieVisitor/uCookieVisitor.pas index a95fda6d..e3198245 100644 --- a/demos/CookieVisitor/uCookieVisitor.pas +++ b/demos/CookieVisitor/uCookieVisitor.pas @@ -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); diff --git a/demos/CustomResourceBrowser/uMainForm.pas b/demos/CustomResourceBrowser/uMainForm.pas index f17033c0..3e0d7626 100644 --- a/demos/CustomResourceBrowser/uMainForm.pas +++ b/demos/CustomResourceBrowser/uMainForm.pas @@ -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); diff --git a/demos/DOMVisitor/uDOMVisitor.pas b/demos/DOMVisitor/uDOMVisitor.pas index 56369c0a..04cc7efa 100644 --- a/demos/DOMVisitor/uDOMVisitor.pas +++ b/demos/DOMVisitor/uDOMVisitor.pas @@ -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. diff --git a/demos/FullScreenBrowser/uMainForm.pas b/demos/FullScreenBrowser/uMainForm.pas index 9e37a45b..080fda7f 100644 --- a/demos/FullScreenBrowser/uMainForm.pas +++ b/demos/FullScreenBrowser/uMainForm.pas @@ -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); diff --git a/demos/Geolocation/uGeolocation.pas b/demos/Geolocation/uGeolocation.pas index 90842e4b..b67b906d 100644 --- a/demos/Geolocation/uGeolocation.pas +++ b/demos/Geolocation/uGeolocation.pas @@ -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); diff --git a/demos/JSEval/uJSEval.pas b/demos/JSEval/uJSEval.pas index 7621ecbf..c76b434f 100644 --- a/demos/JSEval/uJSEval.pas +++ b/demos/JSEval/uJSEval.pas @@ -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); diff --git a/demos/JSExtension/uJSExtension.pas b/demos/JSExtension/uJSExtension.pas index 44fee128..a3e10c87 100644 --- a/demos/JSExtension/uJSExtension.pas +++ b/demos/JSExtension/uJSExtension.pas @@ -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); diff --git a/demos/MiniBrowser/uMiniBrowser.pas b/demos/MiniBrowser/uMiniBrowser.pas index e216a6e1..d7973add 100644 --- a/demos/MiniBrowser/uMiniBrowser.pas +++ b/demos/MiniBrowser/uMiniBrowser.pas @@ -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); diff --git a/demos/PostDataInspector/uPostDataInspector.pas b/demos/PostDataInspector/uPostDataInspector.pas index ad26c0ef..3263fcc7 100644 --- a/demos/PostDataInspector/uPostDataInspector.pas +++ b/demos/PostDataInspector/uPostDataInspector.pas @@ -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); diff --git a/demos/SchemeRegistrationBrowser/uSchemeRegistrationBrowser.pas b/demos/SchemeRegistrationBrowser/uSchemeRegistrationBrowser.pas index d90c600a..d379cfcc 100644 --- a/demos/SchemeRegistrationBrowser/uSchemeRegistrationBrowser.pas +++ b/demos/SchemeRegistrationBrowser/uSchemeRegistrationBrowser.pas @@ -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); diff --git a/demos/SimpleBrowser/uSimpleBrowser.dfm b/demos/SimpleBrowser/uSimpleBrowser.dfm index ce308278..dec26328 100644 --- a/demos/SimpleBrowser/uSimpleBrowser.dfm +++ b/demos/SimpleBrowser/uSimpleBrowser.dfm @@ -65,7 +65,7 @@ object Form1: TForm1 Enabled = False Interval = 300 OnTimer = Timer1Timer - Left = 552 - Top = 264 + Left = 56 + Top = 88 end end diff --git a/demos/SimpleBrowser/uSimpleBrowser.pas b/demos/SimpleBrowser/uSimpleBrowser.pas index 82935f7c..8d30473f 100644 --- a/demos/SimpleBrowser/uSimpleBrowser.pas +++ b/demos/SimpleBrowser/uSimpleBrowser.pas @@ -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); diff --git a/demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm b/demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm index 2d189d79..63ac08e2 100644 --- a/demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm +++ b/demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm @@ -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 diff --git a/demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas b/demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas index 8b0b3e55..1e80ca97 100644 --- a/demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas +++ b/demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas @@ -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. diff --git a/demos/SubProcess/uSimpleBrowser.pas b/demos/SubProcess/uSimpleBrowser.pas index 82935f7c..8d30473f 100644 --- a/demos/SubProcess/uSimpleBrowser.pas +++ b/demos/SubProcess/uSimpleBrowser.pas @@ -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); diff --git a/source/CEF4Delphi.dpk b/source/CEF4Delphi.dpk index e6f85d78..4ab30459 100644 --- a/source/CEF4Delphi.dpk +++ b/source/CEF4Delphi.dpk @@ -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. diff --git a/source/CEF4Delphi.dproj b/source/CEF4Delphi.dproj index 9e95892a..a0947c3d 100644 --- a/source/CEF4Delphi.dproj +++ b/source/CEF4Delphi.dproj @@ -220,6 +220,7 @@ + Cfg_2 Base @@ -250,6 +251,12 @@ + + + CEF4Delphi.bpl + true + + diff --git a/source/CEF4Delphi_D7.dpk b/source/CEF4Delphi_D7.dpk index 1a5e11c4..04f53347 100644 --- a/source/CEF4Delphi_D7.dpk +++ b/source/CEF4Delphi_D7.dpk @@ -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. diff --git a/source/uBufferPanel.pas b/source/uBufferPanel.pas new file mode 100644 index 00000000..1afd2f17 --- /dev/null +++ b/source/uBufferPanel.pas @@ -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 + * 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. diff --git a/source/uCEFApplication.pas b/source/uCEFApplication.pas index 1511211e..7f5a7bc9 100644 --- a/source/uCEFApplication.pas +++ b/source/uCEFApplication.pas @@ -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'; diff --git a/source/uCEFRegisterComponents.pas b/source/uCEFRegisterComponents.pas index aa4e4c59..4f48f07c 100644 --- a/source/uCEFRegisterComponents.pas +++ b/source/uCEFRegisterComponents.pas @@ -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.