pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-02-02 10:25:26 +02:00
Code Issues Actions Releases Activity

Workaround for issue #271

Browse Source
This commit is contained in:
Salvador Díaz Fau 2020-03-31 12:44:10 +02:00
parent 1984ab16ba
commit 7662b61778
15 changed files with 850 additions and 677 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
demos/Delphi_FMX/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View File

@ -207,6 +207,7 @@ begin
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TFMXExternalPumpBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
@ -634,11 +635,27 @@ end;
procedure TFMXExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
rect.x := 0;
rect.y := 0;
rect.width := round(Panel1.Width);
rect.height := round(Panel1.Height);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if GlobalCEFApp.EnableGPU then
begin
TempScale := Panel1.ScreenScale;
if (TempScale <> 1) then
begin
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
end;
procedure TFMXExternalPumpBrowserFrm.chrmosrPaint( Sender : TObject;

26
demos/Delphi_FMX/FMXTabbedOSRBrowser/uBrowserFrame.pas
View File

@ -139,7 +139,6 @@ type
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure DoResize;
procedure NotifyMoveOrResizeStarted;
procedure SendCaptureLostEvent;
procedure HandleSYSCHAR(const aMessage : TMsg);
@ -213,17 +212,12 @@ begin
FMXChromium1.Reload;
end;
procedure TBrowserFrame.ResizeBrowser;
begin
DoResize;
end;
procedure TBrowserFrame.FocusBrowser;
begin
FMXBufferPanel1.SetFocus;
end;
procedure TBrowserFrame.DoResize;
procedure TBrowserFrame.ResizeBrowser;
begin
try
if (FResizeCS <> nil) then
@ -514,7 +508,7 @@ end;
procedure TBrowserFrame.FMXBufferPanel1Resize(Sender: TObject);
begin
DoResize;
ResizeBrowser;
end;
procedure TBrowserFrame.FMXChromium1AddressChange(Sender: TObject;
@ -593,11 +587,27 @@ end;
procedure TBrowserFrame.FMXChromium1GetViewRect(Sender: TObject;
const browser: ICefBrowser; var rect: TCefRect);
var
TempScale : single;
begin
rect.x := 0;
rect.y := 0;
rect.width := round(FMXBufferPanel1.Width);
rect.height := round(FMXBufferPanel1.Height);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if GlobalCEFApp.EnableGPU then
begin
TempScale := FMXBufferPanel1.ScreenScale;
if (TempScale <> 1) then
begin
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
end;
procedure TBrowserFrame.FMXChromium1LoadError(Sender: TObject;

1
demos/Delphi_FMX/FMXTabbedOSRBrowser/uMainForm.pas
View File

@ -180,6 +180,7 @@ begin
GlobalCEFApp.cache := 'cache';
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
GlobalCEFApp.OnContextInitialized := GlobalCEFApp_OnContextInitialized;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TMainForm.NotifyMoveOrResizeStarted;

170
demos/Delphi_VCL/ConsoleBrowser/uWebBrowser.pas
View File

@ -256,12 +256,12 @@ begin
end;
WM_MOUSEWHEEL :
if Panel1.Focused and (GlobalCEFApp <> nil) then
if Panel1.Focused then
begin
TempMouseEvent.x := Msg.lParam and $FFFF;
TempMouseEvent.y := Msg.lParam shr 16;
TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam);
DeviceToLogical(TempMouseEvent, GlobalCEFApp.DeviceScaleFactor);
DeviceToLogical(TempMouseEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempMouseEvent, 0, int16(Msg.wParam shr 16));
end;
end;
@ -316,26 +316,23 @@ procedure TWebBrowserFrm.chrmosrGetScreenInfo( Sender : TObject;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TWebBrowserFrm.chrmosrGetScreenPoint( Sender : TObject;
@ -347,30 +344,36 @@ procedure TWebBrowserFrm.chrmosrGetScreenPoint( Sender : TObject;
out Result : Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TWebBrowserFrm.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if (GlobalCEFApp <> nil) and GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
@ -510,15 +513,12 @@ procedure TWebBrowserFrm.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
procedure TWebBrowserFrm.chrmosrTooltip( Sender : TObject;
@ -685,28 +685,25 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TWebBrowserFrm.Panel1MouseLeave(Sender: TObject);
@ -715,19 +712,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TWebBrowserFrm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -735,30 +729,24 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TWebBrowserFrm.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TWebBrowserFrm.Panel1Resize(Sender: TObject);

201
demos/Delphi_VCL/KioskOSRBrowser/uKioskOSRBrowser.pas
View File

@ -185,6 +185,7 @@ begin
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.TouchEvents := STATE_ENABLED;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
@ -297,12 +298,12 @@ begin
end;
WM_MOUSEWHEEL :
if Panel1.Focused and (GlobalCEFApp <> nil) then
if Panel1.Focused then
begin
TempMouseEvent.x := Msg.lParam and $FFFF;
TempMouseEvent.y := Msg.lParam shr 16;
TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam);
DeviceToLogical(TempMouseEvent, GlobalCEFApp.DeviceScaleFactor);
DeviceToLogical(TempMouseEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempMouseEvent, 0, int16(Msg.wParam shr 16));
end;
end;
@ -381,26 +382,23 @@ procedure TForm1.chrmosrGetScreenInfo( Sender : TObject;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TForm1.chrmosrGetScreenPoint( Sender : TObject;
@ -412,30 +410,36 @@ procedure TForm1.chrmosrGetScreenPoint( Sender : TObject;
out Result : Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TForm1.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if (GlobalCEFApp <> nil) and GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
@ -575,15 +579,12 @@ procedure TForm1.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
procedure TForm1.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean);
@ -764,6 +765,7 @@ var
TempPoint : TPoint;
TempLParam : LPARAM;
TempResult : LRESULT;
TempScale : single;
begin
if not(Panel1.Focused) or (GlobalCEFApp = nil) then exit;
@ -798,9 +800,10 @@ begin
end;
end;
TempScale := Panel1.ScreenScale;
TempPoint := Panel1.ScreenToClient(TempPoint);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
// Touch point identifier stays consistent in a touch contact sequence
TempTouchEvent.id := TempTouchInputs[i].dwID;
@ -833,28 +836,29 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TForm1.Panel1MouseLeave(Sender: TObject);
@ -863,19 +867,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -883,30 +884,32 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TForm1.Panel1PointerDown(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
@ -1022,6 +1025,7 @@ var
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
@ -1069,9 +1073,10 @@ begin
if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempScale := Panel1.ScreenScale;
TempPoint := Panel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
chrmosr.SendTouchEvent(@TempTouchEvent);
end;
@ -1081,6 +1086,7 @@ var
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
@ -1116,9 +1122,10 @@ begin
if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempScale := Panel1.ScreenScale;
TempPoint := Panel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
chrmosr.SendTouchEvent(@TempTouchEvent);
end;

199
demos/Delphi_VCL/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas
View File

@ -189,6 +189,7 @@ begin
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.OnScheduleMessagePumpWork := GlobalCEFApp_OnScheduleMessagePumpWork;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TOSRExternalPumpBrowserFrm.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
@ -294,12 +295,12 @@ begin
end;
WM_MOUSEWHEEL :
if Panel1.Focused and (GlobalCEFApp <> nil) then
if Panel1.Focused then
begin
TempMouseEvent.x := Msg.lParam and $FFFF;
TempMouseEvent.y := Msg.lParam shr 16;
TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam);
DeviceToLogical(TempMouseEvent, GlobalCEFApp.DeviceScaleFactor);
DeviceToLogical(TempMouseEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempMouseEvent, 0, int16(Msg.wParam shr 16));
end;
end;
@ -344,7 +345,7 @@ begin
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrCursorChange(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrCursorChange( Sender : TObject;
const browser : ICefBrowser;
cursor : HICON;
cursorType : TCefCursorType;
@ -353,34 +354,31 @@ begin
Panel1.Cursor := CefCursorToWindowsCursor(cursorType);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenInfo(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenInfo( Sender : TObject;
const browser : ICefBrowser;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObject;
const browser : ICefBrowser;
viewX : Integer;
viewY : Integer;
@ -389,30 +387,36 @@ procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint(Sender : TObject;
out Result : Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetViewRect(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if (GlobalCEFApp <> nil) and GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
@ -533,7 +537,7 @@ begin
end;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupShow(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupShow( Sender : TObject;
const browser : ICefBrowser;
show : Boolean);
begin
@ -548,19 +552,16 @@ begin
end;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupSize(Sender : TObject;
procedure TOSRExternalPumpBrowserFrm.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean);
@ -712,28 +713,29 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject);
@ -742,19 +744,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -762,30 +761,32 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Resize(Sender: TObject);
@ -897,6 +898,7 @@ var
TempDeviceBounds : TCefRectDynArray;
TempPRect : PCefRect;
i : NativeUInt;
TempScale : single;
begin
TempDeviceBounds := nil;
@ -907,11 +909,12 @@ begin
i := 0;
TempPRect := character_bounds;
TempScale := Panel1.ScreenScale;
while (i < character_boundsCount) do
begin
TempDeviceBounds[i] := TempPRect^;
LogicalToDevice(TempDeviceBounds[i], GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(TempDeviceBounds[i], TempScale);
inc(TempPRect);
inc(i);

205
demos/Delphi_VCL/SimpleOSRBrowser/uSimpleOSRBrowser.pas
View File

@ -231,6 +231,7 @@ begin
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.TouchEvents := STATE_ENABLED;
//GlobalCEFApp.EnableGPU := True;
// If you need transparency leave the GlobalCEFApp.BackgroundColor property
// with the default value or set the alpha channel to 0
@ -343,12 +344,12 @@ begin
end;
WM_MOUSEWHEEL :
if Panel1.Focused and (GlobalCEFApp <> nil) then
if Panel1.Focused then
begin
TempMouseEvent.x := Msg.lParam and $FFFF;
TempMouseEvent.y := Msg.lParam shr 16;
TempMouseEvent.modifiers := GetCefMouseModifiers(Msg.wParam);
DeviceToLogical(TempMouseEvent, GlobalCEFApp.DeviceScaleFactor);
DeviceToLogical(TempMouseEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempMouseEvent, 0, smallint(Msg.wParam shr 16));
end;
end;
@ -413,26 +414,23 @@ procedure TForm1.chrmosrGetScreenInfo( Sender : TObject;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TForm1.chrmosrGetScreenPoint( Sender : TObject;
@ -444,30 +442,36 @@ procedure TForm1.chrmosrGetScreenPoint( Sender : TObject;
out Result : Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TForm1.chrmosrGetViewRect( Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if (GlobalCEFApp <> nil) and GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
@ -607,15 +611,12 @@ procedure TForm1.chrmosrPopupSize( Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
FPopUpRect.Left := rect.x;
FPopUpRect.Top := rect.y;
FPopUpRect.Right := rect.x + rect.width - 1;
FPopUpRect.Bottom := rect.y + rect.height - 1;
end;
procedure TForm1.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var text: ustring; out Result: Boolean);
@ -812,6 +813,7 @@ end;
procedure TForm1.Panel1CustomTouch(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
{$IFDEF DELPHI14_UP}
var
TempScale : single;
TempTouchEvent : TCefTouchEvent;
TempHTOUCHINPUT : HTOUCHINPUT;
TempNumPoints : integer;
@ -832,6 +834,7 @@ begin
SetLength(TempTouchInputs, TempNumPoints);
TempHTOUCHINPUT := HTOUCHINPUT(aMessage.lParam);
TempScale := Panel1.ScreenScale;
if GetTouchInputInfo(TempHTOUCHINPUT, TempNumPoints, @TempTouchInputs[0], SizeOf(TTouchInput)) then
begin
@ -857,8 +860,8 @@ begin
end;
TempPoint := Panel1.ScreenToClient(TempPoint);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
// Touch point identifier stays consistent in a touch contact sequence
TempTouchEvent.id := TempTouchInputs[i].dwID;
@ -892,28 +895,29 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) {$IFDEF DELPHI14_UP}and not(ssTouch in Shift){$ENDIF} then
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TForm1.Panel1MouseLeave(Sender: TObject);
@ -922,19 +926,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -942,30 +943,32 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) {$IFDEF DELPHI14_UP}and not(ssTouch in Shift){$ENDIF} then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) {$IFDEF DELPHI14_UP}and not(ssTouch in Shift){$ENDIF} then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
{$IFDEF DELPHI14_UP}
if (ssTouch in Shift) then exit;
{$ENDIF}
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TForm1.Panel1PaintParentBkg(Sender: TObject);
@ -1043,6 +1046,7 @@ var
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
@ -1090,9 +1094,10 @@ begin
if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempScale := Panel1.ScreenScale;
TempPoint := Panel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
chrmosr.SendTouchEvent(@TempTouchEvent);
end;
@ -1102,6 +1107,7 @@ var
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
@ -1137,9 +1143,10 @@ begin
if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempScale := Panel1.ScreenScale;
TempPoint := Panel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, TempScale);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, TempScale);
chrmosr.SendTouchEvent(@TempTouchEvent);
end;
@ -1253,6 +1260,7 @@ procedure TForm1.chrmosrIMECompositionRangeChanged( Sender :
var
TempPRect : PCefRect;
i : NativeUInt;
TempScale : single;
begin
try
FIMECS.Acquire;
@ -1277,11 +1285,12 @@ begin
i := 0;
TempPRect := character_bounds;
TempScale := Panel1.ScreenScale;
while (i < character_boundsCount) do
begin
FDeviceBounds[i] := TempPRect^;
LogicalToDevice(FDeviceBounds[i], GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(FDeviceBounds[i], TempScale);
inc(TempPRect);
inc(i);

70
demos/Lazarus/OSRExternalPumpBrowser/OSRExternalPumpBrowser.lps
View File

@ -22,8 +22,8 @@
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="31"/>
<CursorPos X="117" Y="38"/>
<TopLine Value="180"/>
<CursorPos X="5" Y="200"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@ -85,127 +85,123 @@
<UsageCount Value="10"/>
</Unit9>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="29" HistoryIndex="28">
<Position1>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="286" Column="70" TopLine="270"/>
<Caret Line="391" Column="71" TopLine="350"/>
</Position1>
<Position2>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="307" Column="11" TopLine="295"/>
<Caret Line="392" Column="71" TopLine="351"/>
</Position2>
<Position3>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="322" TopLine="313"/>
<Caret Line="535" Column="48" TopLine="496"/>
</Position3>
<Position4>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="503" Column="53" TopLine="488"/>
<Caret Line="537" Column="48" TopLine="496"/>
</Position4>
<Position5>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="92" Column="27" TopLine="92"/>
<Caret Line="807" Column="52" TopLine="766"/>
</Position5>
<Position6>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="503" Column="11" TopLine="499"/>
<Caret Line="828" Column="52" TopLine="787"/>
</Position6>
<Position7>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="201" Column="11" TopLine="166"/>
<Caret Line="845" Column="52" TopLine="804"/>
</Position7>
<Position8>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="982" Column="68" TopLine="963"/>
<Caret Line="859" Column="52" TopLine="818"/>
</Position8>
<Position9>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="307" Column="39" TopLine="301"/>
<Caret Line="1009" Column="52" TopLine="968"/>
</Position9>
<Position10>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="82" Column="44" TopLine="77"/>
<Caret Line="257" Column="51" TopLine="217"/>
</Position10>
<Position11>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="957" TopLine="939"/>
<Caret Line="354" Column="21" TopLine="317"/>
</Position11>
<Position12>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="958" TopLine="939"/>
<Caret Line="364" Column="56" TopLine="337"/>
</Position12>
<Position13>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="957" TopLine="939"/>
<Caret Line="365" Column="37" TopLine="337"/>
</Position13>
<Position14>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="958" TopLine="939"/>
<Caret Line="384" Column="58" TopLine="343"/>
</Position14>
<Position15>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="960" TopLine="939"/>
<Caret Line="531" Column="54" TopLine="502"/>
</Position15>
<Position16>
<Filename Value="OSRExternalPumpBrowser.lpr"/>
<Caret Line="61" Column="63" TopLine="41"/>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="794" Column="91" TopLine="754"/>
</Position16>
<Position17>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="169" Column="11" TopLine="153"/>
<Caret Line="812" Column="50" TopLine="772"/>
</Position17>
<Position18>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="198" TopLine="176"/>
<Caret Line="826" Column="52" TopLine="786"/>
</Position18>
<Position19>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="170" Column="82" TopLine="148"/>
<Caret Line="837" Column="87" TopLine="818"/>
</Position19>
<Position20>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="217" Column="51" TopLine="196"/>
<Caret Line="984" Column="59" TopLine="944"/>
</Position20>
<Position21>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="105" Column="30" TopLine="71"/>
<Caret Line="252" Column="40" TopLine="229"/>
</Position21>
<Position22>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="282" TopLine="278"/>
<Caret Line="342" Column="40" TopLine="319"/>
</Position22>
<Position23>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="945" Column="91" TopLine="926"/>
<Caret Line="365" Column="37" TopLine="354"/>
</Position23>
<Position24>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="944" Column="91" TopLine="925"/>
<Caret Line="380" Column="36" TopLine="354"/>
</Position24>
<Position25>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="943" Column="110" TopLine="925"/>
<Caret Line="526" Column="44" TopLine="497"/>
</Position25>
<Position26>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="7" Column="109"/>
<Caret Line="793" Column="48" TopLine="767"/>
</Position26>
<Position27>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="168" Column="26" TopLine="145"/>
<Caret Line="811" Column="48" TopLine="770"/>
</Position27>
<Position28>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="337" Column="52" TopLine="312"/>
<Caret Line="825" Column="48" TopLine="784"/>
</Position28>
<Position29>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="94" Column="15" TopLine="81"/>
<Caret Line="836" Column="48" TopLine="795"/>
</Position29>
<Position30>
<Filename Value="uOSRExternalPumpBrowser.pas"/>
<Caret Line="488" Column="19" TopLine="456"/>
</Position30>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>

179
demos/Lazarus/OSRExternalPumpBrowser/uOSRExternalPumpBrowser.pas
View File

@ -197,6 +197,7 @@ begin
GlobalCEFApp.ExternalMessagePump := True;
GlobalCEFApp.MultiThreadedMessageLoop := False;
GlobalCEFApp.OnScheduleMessagePumpWork := @GlobalCEFApp_OnScheduleMessagePumpWork;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TOSRExternalPumpBrowserFrm.GoBtnClick(Sender: TObject);
@ -223,6 +224,7 @@ procedure TOSRExternalPumpBrowserFrm.chrmosrIMECompositionRangeChanged( Sen
var
TempPRect : PCefRect;
i : NativeUInt;
TempScale : single;
begin
try
FIMECS.Acquire;
@ -247,11 +249,12 @@ begin
i := 0;
TempPRect := character_bounds;
TempScale := Panel1.ScreenScale;
while (i < character_boundsCount) do
begin
FDeviceBounds[i] := TempPRect^;
LogicalToDevice(FDeviceBounds[i], GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(FDeviceBounds[i], TempScale);
inc(TempPRect);
inc(i);
@ -333,26 +336,23 @@ procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenInfo(Sender : TObject;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint(Sender: TObject;
@ -360,31 +360,28 @@ procedure TOSRExternalPumpBrowserFrm.chrmosrGetScreenPoint(Sender: TObject;
screenY: Integer; out Result: Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrGetViewRect(Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
end;
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrPaint(Sender: TObject; const browser: ICefBrowser;
@ -526,15 +523,12 @@ procedure TOSRExternalPumpBrowserFrm.chrmosrPopupSize(Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect^.x;
FPopUpRect.Top := rect^.y;
FPopUpRect.Right := rect^.x + rect^.width - 1;
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
end;
FPopUpRect.Left := rect^.x;
FPopUpRect.Top := rect^.y;
FPopUpRect.Right := rect^.x + rect^.width - 1;
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
end;
procedure TOSRExternalPumpBrowserFrm.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var aText: ustring; out Result: Boolean);
@ -779,28 +773,25 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseLeave(Sender: TObject);
@ -809,19 +800,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -829,30 +817,24 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TOSRExternalPumpBrowserFrm.Panel1Resize(Sender: TObject);
@ -995,14 +977,11 @@ procedure TOSRExternalPumpBrowserFrm.Panel1MouseWheel(Sender: TObject; Shift: TS
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := MousePos.x;
TempEvent.y := MousePos.y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
TempEvent.x := MousePos.x;
TempEvent.y := MousePos.y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
procedure TOSRExternalPumpBrowserFrm.SnapshotBtnClick(Sender: TObject);

117
demos/Lazarus/SimpleOSRBrowser/SimpleOSRBrowser.lps
View File

@ -4,14 +4,13 @@
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="28">
<Units Count="29">
<Unit0>
<Filename Value="SimpleOSRBrowser.lpr"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<EditorIndex Value="1"/>
<TopLine Value="30"/>
<CursorPos X="77" Y="11"/>
<CursorPos X="28" Y="39"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -38,11 +37,13 @@
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<TopLine Value="43"/>
<CursorPos X="93" Y="376"/>
<IsVisibleTab Value="True"/>
<TopLine Value="188"/>
<CursorPos X="5" Y="215"/>
<UsageCount Value="42"/>
<Bookmarks Count="1">
<Item0 X="40" Y="262" ID="4"/>
<Bookmarks Count="2">
<Item0 X="40" Y="301" ID="4"/>
<Item1 X="41" Y="261" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@ -230,94 +231,140 @@
</Unit26>
<Unit27>
<Filename Value="..\..\..\source\uCEFBufferPanel.pas"/>
<EditorIndex Value="1"/>
<TopLine Value="417"/>
<CursorPos X="10" Y="400"/>
<EditorIndex Value="-1"/>
<TopLine Value="44"/>
<CursorPos X="5" Y="54"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\source\uCEFConstants.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="601"/>
<CursorPos X="69" Y="621"/>
<UsageCount Value="10"/>
</Unit28>
</Units>
<JumpHistory Count="20" HistoryIndex="19">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="204" Column="63" TopLine="19"/>
<Caret Line="343" Column="64" TopLine="320"/>
</Position1>
<Position2>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="100" Column="24" TopLine="89"/>
<Caret Line="344" Column="64" TopLine="320"/>
</Position2>
<Position3>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="279" Column="33" TopLine="273"/>
<Caret Line="358" Column="26" TopLine="321"/>
</Position3>
<Position4>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="99" Column="382" TopLine="73"/>
<Caret Line="364" Column="71" TopLine="323"/>
</Position4>
<Position5>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="155" Column="11" TopLine="140"/>
<Caret Line="365" Column="71" TopLine="324"/>
</Position5>
<Position6>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="936" Column="78" TopLine="919"/>
<Caret Line="507" TopLine="469"/>
</Position6>
<Position7>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="155" Column="29" TopLine="139"/>
<Caret Line="510" Column="48" TopLine="469"/>
</Position7>
<Position8>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="184" Column="46" TopLine="161"/>
<Caret Line="780" Column="52" TopLine="739"/>
</Position8>
<Position9>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="187" Column="46" TopLine="164"/>
<Caret Line="801" Column="52" TopLine="760"/>
</Position9>
<Position10>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="917" Column="109" TopLine="25"/>
<Caret Line="818" Column="52" TopLine="777"/>
</Position10>
<Position11>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="916" Column="109" TopLine="887"/>
<Caret Line="832" Column="52" TopLine="791"/>
</Position11>
<Position12>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="65" Column="25" TopLine="58"/>
<Caret Line="982" Column="52" TopLine="941"/>
</Position12>
<Position13>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="195" TopLine="192"/>
<Caret Line="224" Column="40" TopLine="201"/>
</Position13>
<Position14>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="102" Column="15" TopLine="87"/>
<Caret Line="318" Column="75" TopLine="238"/>
</Position14>
<Position15>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="65" TopLine="59"/>
<Caret Line="225" Column="59" TopLine="201"/>
</Position15>
<Position16>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="197" Column="68" TopLine="168"/>
<Caret Line="320" Column="46" TopLine="292"/>
</Position16>
<Position17>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="91" Column="15" TopLine="85"/>
<Caret Line="343" Column="28" TopLine="310"/>
</Position17>
<Position18>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="376" Column="93" TopLine="43"/>
<Caret Line="365" Column="9" TopLine="344"/>
</Position18>
<Position19>
<Filename Value="..\..\..\source\uCEFBufferPanel.pas"/>
<Caret Line="154" Column="57" TopLine="135"/>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="512" Column="55" TopLine="486"/>
</Position19>
<Position20>
<Filename Value="..\..\..\source\uCEFBufferPanel.pas"/>
<Caret Line="263" TopLine="269"/>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="775" Column="86" TopLine="735"/>
</Position20>
<Position21>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="793" Column="54" TopLine="765"/>
</Position21>
<Position22>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="807" Column="56" TopLine="782"/>
</Position22>
<Position23>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="818" Column="86" TopLine="797"/>
</Position23>
<Position24>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="965" Column="60" TopLine="936"/>
</Position24>
<Position25>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="224" Column="40" TopLine="201"/>
</Position25>
<Position26>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="314" Column="40" TopLine="310"/>
</Position26>
<Position27>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="337" Column="37" TopLine="309"/>
</Position27>
<Position28>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="352" Column="36" TopLine="338"/>
</Position28>
<Position29>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="507" Column="44" TopLine="496"/>
</Position29>
<Position30>
<Filename Value="usimplelazosrbrowser.pas"/>
<Caret Line="774" Column="48" TopLine="745"/>
</Position30>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>

224
demos/Lazarus/SimpleOSRBrowser/usimplelazosrbrowser.pas
View File

@ -163,6 +163,42 @@ uses
Math,
uCEFMiscFunctions, uCEFApplication;
// Chromium renders the web contents asynchronously. It uses multiple processes
// and threads which makes it complicated to keep the correct browser size.
// In one hand you have the main application thread where the form is resized by
// the user. On the other hand, Chromium renders the contents asynchronously
// with the last browser size available, which may have changed by the time
// Chromium renders the page.
// For this reason we need to keep checking the real size and call
// TChromium.WasResized when we detect that Chromium has an incorrect size.
// TChromium.WasResized triggers the TChromium.OnGetViewRect event to let CEF
// read the current browser size and then it triggers TChromium.OnPaint when the
// contents are finally rendered.
// TChromium.WasResized --> (time passes) --> TChromium.OnGetViewRect --> (time passes) --> TChromium.OnPaint
// You have to assume that the real browser size can change between those calls
// and events.
// This demo uses a couple of fields called "FResizing" and "FPendingResize" to
// reduce the number of TChromium.WasResized calls.
// FResizing is set to True before the TChromium.WasResized call and it's set to
// False at the end of the TChromium.OnPaint event.
// FPendingResize is set to True when the browser changed its size while
// FResizing was True. The FPendingResize value is checked at the end of
// TChromium.OnPaint to check the browser size again because it changed while
// Chromium was rendering the page.
// The TChromium.OnPaint event in the demo also calls
// TBufferPanel.UpdateBufferDimensions and TBufferPanel.BufferIsResized to check
// the width and height of the buffer parameter, and the internal buffer size in
// the TBufferPanel component.
// This is the destruction sequence in OSR mode :
// 1- FormCloseQuery sets CanClose to the initial FCanClose value (False) and calls chrmosr.CloseBrowser(True).
// 2- chrmosr.CloseBrowser(True) will trigger chrmosr.OnClose and we have to
@ -175,7 +211,8 @@ procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.EnableHighDPISupport := True;
//GlobalCEFApp.EnableGPU := True;
end;
procedure TForm1.GoBtnClick(Sender: TObject);
@ -196,6 +233,7 @@ procedure TForm1.chrmosrIMECompositionRangeChanged( Sender :
var
TempPRect : PCefRect;
i : NativeUInt;
TempScale : single;
begin
try
FIMECS.Acquire;
@ -220,11 +258,12 @@ begin
i := 0;
TempPRect := character_bounds;
TempScale := Panel1.ScreenScale;
while (i < character_boundsCount) do
begin
FDeviceBounds[i] := TempPRect^;
LogicalToDevice(FDeviceBounds[i], GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(FDeviceBounds[i], TempScale);
inc(TempPRect);
inc(i);
@ -306,57 +345,60 @@ procedure TForm1.chrmosrGetScreenInfo(Sender : TObject;
var screenInfo : TCefScreenInfo;
out Result : Boolean);
var
TempRect : TCEFRect;
TempRect : TCEFRect;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
TempRect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
TempScale := Panel1.ScreenScale;
TempRect.x := 0;
TempRect.y := 0;
TempRect.width := DeviceToLogical(Panel1.Width, TempScale);
TempRect.height := DeviceToLogical(Panel1.Height, TempScale);
screenInfo.device_scale_factor := GlobalCEFApp.DeviceScaleFactor;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
screenInfo.device_scale_factor := TempScale;
screenInfo.depth := 0;
screenInfo.depth_per_component := 0;
screenInfo.is_monochrome := Ord(False);
screenInfo.rect := TempRect;
screenInfo.available_rect := TempRect;
Result := True;
end
else
Result := False;
Result := True;
end;
procedure TForm1.chrmosrGetScreenPoint(Sender: TObject;
const browser: ICefBrowser; viewX, viewY: Integer; var screenX,
screenY: Integer; out Result: Boolean);
var
TempScreenPt, TempViewPt : TPoint;
TempScreenPt, TempViewPt : TPoint;
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
begin
TempViewPt.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor);
TempViewPt.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end
else
Result := False;
TempScale := Panel1.ScreenScale;
TempViewPt.x := LogicalToDevice(viewX, TempScale);
TempViewPt.y := LogicalToDevice(viewY, TempScale);
TempScreenPt := Panel1.ClientToScreen(TempViewPt);
screenX := TempScreenPt.x;
screenY := TempScreenPt.y;
Result := True;
end;
procedure TForm1.chrmosrGetViewRect(Sender : TObject;
const browser : ICefBrowser;
var rect : TCefRect);
var
TempScale : single;
begin
if (GlobalCEFApp <> nil) then
TempScale := Panel1.ScreenScale;
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, TempScale);
rect.height := DeviceToLogical(Panel1.Height, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if (GlobalCEFApp <> nil) and GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
rect.x := 0;
rect.y := 0;
rect.width := DeviceToLogical(Panel1.Width, GlobalCEFApp.DeviceScaleFactor);
rect.height := DeviceToLogical(Panel1.Height, GlobalCEFApp.DeviceScaleFactor);
while (Frac(rect.width * TempScale) <> 0) do dec(rect.width);
while (Frac(rect.height * TempScale) <> 0) do dec(rect.height);
end;
end;
@ -499,15 +541,12 @@ procedure TForm1.chrmosrPopupSize(Sender : TObject;
const browser : ICefBrowser;
const rect : PCefRect);
begin
if (GlobalCEFApp <> nil) then
begin
LogicalToDevice(rect^, GlobalCEFApp.DeviceScaleFactor);
LogicalToDevice(rect^, Panel1.ScreenScale);
FPopUpRect.Left := rect^.x;
FPopUpRect.Top := rect^.y;
FPopUpRect.Right := rect^.x + rect^.width - 1;
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
end;
FPopUpRect.Left := rect^.x;
FPopUpRect.Top := rect^.y;
FPopUpRect.Right := rect^.x + rect^.width - 1;
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
end;
procedure TForm1.chrmosrTooltip(Sender: TObject; const browser: ICefBrowser; var aText: ustring; out Result: Boolean);
@ -752,28 +791,25 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
Panel1.SetFocus;
if not(CancelPreviousClick(x, y, TempTime)) and (Button = FLastClickButton) then
inc(FLastClickCount)
else
begin
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
FLastClickPoint.x := x;
FLastClickPoint.y := y;
FLastClickCount := 1;
end;
FLastClickTime := TempTime;
FLastClickButton := Button;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, FLastClickCount);
end;
procedure TForm1.Panel1MouseLeave(Sender: TObject);
@ -782,19 +818,16 @@ var
TempPoint : TPoint;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
GetCursorPos(TempPoint);
TempPoint := Panel1.ScreenToclient(TempPoint);
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
if CancelPreviousClick(TempPoint.x, TempPoint.y, TempTime) then InitializeLastClick;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
TempEvent.x := TempPoint.x;
TempEvent.y := TempPoint.y;
TempEvent.modifiers := GetCefMouseModifiers;
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, True);
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -802,30 +835,24 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
TempEvent.x := x;
TempEvent.y := y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseMoveEvent(@TempEvent, False);
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
TempEvent.x := X;
TempEvent.y := Y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, FLastClickCount);
end;
procedure TForm1.Panel1Resize(Sender: TObject);
@ -968,14 +995,11 @@ procedure TForm1.Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
begin
TempEvent.x := MousePos.x;
TempEvent.y := MousePos.y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
TempEvent.x := MousePos.x;
TempEvent.y := MousePos.y;
TempEvent.modifiers := getModifiers(Shift);
DeviceToLogical(TempEvent, Panel1.ScreenScale);
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
end;
procedure TForm1.SnapshotBtnClick(Sender: TObject);

104
source/uCEFBufferPanel.pas
View File

@ -47,8 +47,8 @@ interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}Winapi.Windows, Winapi.Messages, Vcl.ExtCtrls, Vcl.Controls, Vcl.Graphics, WinApi.Imm,{$ENDIF}
System.Classes, System.SyncObjs, System.SysUtils,
{$IFDEF MSWINDOWS}Winapi.Windows, Winapi.Messages, Vcl.ExtCtrls, Vcl.Controls, Vcl.Graphics, WinApi.Imm, {$ENDIF}
System.Classes, System.SyncObjs, System.SysUtils, Vcl.Forms,
{$ELSE}
{$IFDEF MSWINDOWS}Windows, imm, {$ENDIF} Classes, Forms, Controls, Graphics,
{$IFDEF FPC}
@ -94,6 +94,11 @@ type
function GetBufferBits : pointer;
function GetBufferWidth : integer;
function GetBufferHeight : integer;
function GetScreenScale : single;
{$IFDEF MSWINDOWS}
function GetParentFormHandle : TCefWindowHandle;
function GetParentForm : TCustomForm;
{$ENDIF}
procedure SetTransparent(aValue : boolean);
@ -130,11 +135,16 @@ type
procedure CreateIMEHandler;
procedure ChangeCompositionRange(const selection_range : TCefRange; const character_bounds : TCefRectDynArray);
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 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 ScreenScale : single read GetScreenScale;
{$IFDEF MSWINDOWS}
property ParentFormHandle : TCefWindowHandle read GetParentFormHandle;
property ParentForm : TCustomForm read GetParentForm;
{$ENDIF}
property DockManager;
property Canvas;
@ -652,6 +662,64 @@ begin
Result := 0;
end;
function TBufferPanel.GetScreenScale : single;
{$IFDEF MSWINDOWS}
var
TempHandle : TCefWindowHandle;
TempDC : HDC;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
TempHandle := ParentFormHandle;
if (TempHandle <> 0) then
begin
TempDC := GetWindowDC(TempHandle);
Result := GetDeviceCaps(TempDC, LOGPIXELSX) / USER_DEFAULT_SCREEN_DPI;
ReleaseDC(TempHandle, TempDC);
end
else
{$ENDIF}
if (GlobalCEFApp <> nil) then
Result := GlobalCEFApp.DeviceScaleFactor
else
Result := 1;
end;
{$IFDEF MSWINDOWS}
function TBufferPanel.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 TBufferPanel.GetParentFormHandle : TCefWindowHandle;
var
TempForm : TCustomForm;
begin
Result := 0;
TempForm := GetParentForm;
if (TempForm <> nil) then
Result := TempForm.Handle
else
if (Application <> nil) and
(Application.MainForm <> nil) then
Result := Application.MainForm.Handle;
end;
{$ENDIF}
procedure TBufferPanel.SetTransparent(aValue : boolean);
begin
if (FTransparent <> aValue) then
@ -698,13 +766,16 @@ end;
function TBufferPanel.BufferIsResized(aUseMutex : boolean) : boolean;
var
TempDevWidth, TempLogWidth, TempDevHeight, TempLogHeight : integer;
TempScale : single;
begin
Result := False;
if (GlobalCEFApp = nil) then exit;
if not(aUseMutex) or BeginBufferDraw then
begin
if (GlobalCEFApp.DeviceScaleFactor = 1) then
TempScale := ScreenScale;
if (TempScale = 1) then
begin
Result := (FBuffer <> nil) and
(FBuffer.Width = Width) and
@ -716,11 +787,20 @@ begin
// and Delphi uses MulDiv, which uses the bankers rounding, to resize the components in high DPI mode.
// This is the cause of slight differences in size between the buffer and the panel in some occasions.
TempLogWidth := DeviceToLogical(Width, GlobalCEFApp.DeviceScaleFactor);
TempLogHeight := DeviceToLogical(Height, GlobalCEFApp.DeviceScaleFactor);
TempLogWidth := DeviceToLogical(Width, TempScale);
TempLogHeight := DeviceToLogical(Height, TempScale);
TempDevWidth := LogicalToDevice(TempLogWidth, GlobalCEFApp.DeviceScaleFactor);
TempDevHeight := LogicalToDevice(TempLogHeight, GlobalCEFApp.DeviceScaleFactor);
TempDevWidth := LogicalToDevice(TempLogWidth, TempScale);
TempDevHeight := LogicalToDevice(TempLogHeight, TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if GlobalCEFApp.EnableGPU then
begin
while (Frac(TempDevWidth * TempScale) <> 0) do dec(TempDevWidth);
while (Frac(TempDevHeight * TempScale) <> 0) do dec(TempDevHeight);
end;
Result := (FBuffer <> nil) and
(FBuffer.Width = TempDevWidth) and

3
source/uCEFConstants.pas
View File

@ -630,6 +630,9 @@ const
CEF_IMAGE_FILE_MACHINE_I386 = $014C;
CEF_IMAGE_FILE_MACHINE_AMD64 = $8664;
{$IFDEF FPC}
USER_DEFAULT_SCREEN_DPI = 96;
{$ENDIF}
implementation
end.

9
source/uCEFFMXBufferPanel.pas
View File

@ -456,6 +456,15 @@ begin
TempWidth := round(Width * TempScale);
TempHeight := round(Height * TempScale);
// Workaround for CEF4Delphi issue #271 (CEF issue #2833)
// https://github.com/salvadordf/CEF4Delphi/issues/271
// https://bitbucket.org/chromiumembedded/cef/issues/2833/osr-gpu-consume-cpu-and-may-not-draw
if GlobalCEFApp.EnableGPU and (TempScale <> 1) then
begin
while (Frac(TempWidth * TempScale) <> 0) do dec(TempWidth);
while (Frac(TempHeight * TempScale) <> 0) do dec(TempHeight);
end;
Result := (FBuffer <> nil) and
(FBuffer.BitmapScale = TempScale) and
(FBuffer.Width = TempWidth) and

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 110,
"InternalVersion" : 111,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "80.1.2.0"
}