From 9a1a3bb3252f0bd7e478c754c7393a216092e327 Mon Sep 17 00:00:00 2001 From: salvadordf Date: Thu, 28 Jul 2022 11:07:26 +0200 Subject: [PATCH] Fixed context menu position in Firemonkey OSR demos running in high DPI monitors Fixed touch and pen handling function in Firemonkey OSR demos running in high DPI monitors. Fixed issue #431: Outdated DCPCrypt project link --- README.md | 2 +- .../FMXExternalPumpBrowser.dproj | 34 +++++------ .../uFMXExternalPumpBrowser.pas | 57 +++++++++++-------- .../FMXSkiaBrowser/FMXSkiaBrowser.dproj | 6 +- .../FMXSkiaBrowser/uMainForm.pas | 51 ++++++++++++----- .../FMXTabbedOSRBrowser.dproj | 28 ++++----- .../FMXTabbedOSRBrowser/uBrowserFrame.pas | 24 +++++--- update_CEF4Delphi.json | 2 +- 8 files changed, 120 insertions(+), 84 deletions(-) diff --git a/README.md b/README.md index 9db9df9a..90a7a134 100644 --- a/README.md +++ b/README.md @@ -42,7 +42,7 @@ Delphinus-Support * [DCEF3](https://github.com/hgourvest/dcef3) * [fpCEF3](https://github.com/dliw/fpCEF3) * [CEF](https://bitbucket.org/chromiumembedded/cef/) -* [DCPcrypt](http://www.cityinthesky.co.uk/opensource/dcpcrypt/) +* [DCPcrypt](https://sourceforge.net/projects/lazarus-ccr/files/DCPcrypt/) * [Chromium](https://chromium.googlesource.com/chromium/src/) ## Attribution diff --git a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj index 54d9e29d..e2523082 100644 --- a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj @@ -1,7 +1,7 @@  {BE24D13B-2634-4064-8746-AB331419C5FA} - 19.3 + 19.4 FMX FMXExternalPumpBrowser.dpr True @@ -219,7 +219,7 @@ false true 1033 - PerMonitor + PerMonitorV2 true @@ -276,9 +276,8 @@ - - - FMXExternalPumpBrowser.exe + + true @@ -292,11 +291,6 @@ true - - - true - - true @@ -312,6 +306,12 @@ true + + + FMXExternalPumpBrowser.exe + true + + 1 @@ -1437,17 +1437,17 @@ 1 - - - - - - + - + + + + + + False diff --git a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas index e4a14804..ea333fe9 100644 --- a/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas +++ b/demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas @@ -591,11 +591,11 @@ var TempScale : single; begin TempScale := Panel1.ScreenScale; - TempViewPt.x := LogicalToDevice(viewX, TempScale); - TempViewPt.y := LogicalToDevice(viewY, TempScale); + TempViewPt.x := viewX; + TempViewPt.y := viewY; TempScreenPt := Panel1.ClientToScreen(TempViewPt); - screenX := TempScreenPt.x; - screenY := TempScreenPt.y; + screenX := LogicalToDevice(TempScreenPt.x, TempScale); + screenY := LogicalToDevice(TempScreenPt.y, TempScale); Result := True; end; @@ -811,25 +811,23 @@ end; procedure TFMXExternalPumpBrowserFrm.DoResize; begin - try - if (FResizeCS <> nil) then - begin - FResizeCS.Acquire; + if (FResizeCS <> nil) then + try + FResizeCS.Acquire; - if FResizing then - FPendingResize := True + if FResizing then + FPendingResize := True + else + if Panel1.BufferIsResized then + chrmosr.Invalidate(PET_VIEW) else - if Panel1.BufferIsResized then - chrmosr.Invalidate(PET_VIEW) - else - begin - FResizing := True; - chrmosr.WasResized; - end; - end; - finally - if (FResizeCS <> nil) then FResizeCS.Release; - end; + begin + FResizing := True; + chrmosr.WasResized; + end; + finally + FResizeCS.Release; + end; end; procedure TFMXExternalPumpBrowserFrm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); @@ -1064,6 +1062,7 @@ var TempPenInfo : POINTER_PEN_INFO; TempTouchEvent : TCefTouchEvent; TempPoint : TPoint; + TempScale : single; begin Result := False; if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit; @@ -1110,8 +1109,11 @@ begin if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPoint := Panel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempScale := Panel1.ScreenScale; + TempPoint.x := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPoint.y := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.y, TempScale); + + TempPoint := Panel1.ScreenToClient(TempPoint); TempTouchEvent.x := TempPoint.x; TempTouchEvent.y := TempPoint.y; @@ -1123,6 +1125,7 @@ var TempTouchInfo : POINTER_TOUCH_INFO; TempTouchEvent : TCefTouchEvent; TempPoint : TPoint; + TempScale : single; begin Result := False; if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit; @@ -1157,8 +1160,12 @@ begin if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPoint := Panel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempScale := Panel1.ScreenScale; + TempPoint.x := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPoint.y := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.y, TempScale); + + TempPoint := Panel1.ScreenToClient(TempPoint); + //TempPoint := Panel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation); TempTouchEvent.x := TempPoint.x; TempTouchEvent.y := TempPoint.y; diff --git a/demos/Delphi_FMX_Windows/FMXSkiaBrowser/FMXSkiaBrowser.dproj b/demos/Delphi_FMX_Windows/FMXSkiaBrowser/FMXSkiaBrowser.dproj index e28a1c7e..3aed0b7c 100644 --- a/demos/Delphi_FMX_Windows/FMXSkiaBrowser/FMXSkiaBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXSkiaBrowser/FMXSkiaBrowser.dproj @@ -219,7 +219,7 @@ false true 1033 - PerMonitor + PerMonitorV2 true @@ -281,12 +281,12 @@ true - + true - + true diff --git a/demos/Delphi_FMX_Windows/FMXSkiaBrowser/uMainForm.pas b/demos/Delphi_FMX_Windows/FMXSkiaBrowser/uMainForm.pas index ee6bdf99..15633cbb 100644 --- a/demos/Delphi_FMX_Windows/FMXSkiaBrowser/uMainForm.pas +++ b/demos/Delphi_FMX_Windows/FMXSkiaBrowser/uMainForm.pas @@ -124,6 +124,7 @@ type function CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean; procedure DoRedraw; procedure DoResize; + function RealScreenScale: single; {$IFDEF MSWINDOWS} function SendCompMessage(aMsg : cardinal; aWParam : WPARAM = 0; aLParam : LPARAM = 0) : boolean; function ArePointerEventsSupported : boolean; @@ -190,7 +191,7 @@ implementation {$R *.fmx} uses - System.SysUtils, System.Math, FMX.Platform, FMX.Platform.Win, + System.SysUtils, System.Math, FMX.Platform, FMX.Platform.Win, FMX.Helpers.Win, uCEFMiscFunctions, uCEFApplication, uFMXApplicationService; procedure GlobalCEFApp_OnScheduleMessagePumpWork(const aDelayMS : int64); @@ -576,15 +577,16 @@ procedure TMainForm.chrmosrGetScreenPoint( Sender : TObject; var screenY : Integer; out Result : Boolean); var - TempPoint : TPointF; + TempScreenPt, TempViewPt : TPointF; + TempScale : single; begin - TempPoint.x := LogicalToDevice(viewX, GlobalCEFApp.DeviceScaleFactor); - TempPoint.y := LogicalToDevice(viewY, GlobalCEFApp.DeviceScaleFactor); - // LocalToScreen applies the scale factor. No need to call LogicalToDevice to set TempViewPt. - TempPoint := Panel1.LocalToScreen(TempPoint); - screenX := round(TempPoint.x); - screenY := round(TempPoint.y); - Result := True; + TempScale := RealScreenScale; + TempViewPt.x := viewX; + TempViewPt.y := viewY; + TempScreenPt := Panel1.LocalToScreen(TempViewPt); + screenX := LogicalToDevice(round(TempScreenPt.x), TempScale); + screenY := LogicalToDevice(round(TempScreenPt.y), TempScale); + Result := True; end; procedure TMainForm.chrmosrGetViewRect( Sender : TObject; @@ -681,6 +683,21 @@ begin chrmosr.WasResized; end; +function TMainForm.RealScreenScale: single; +var + TempHandle: TCefWindowHandle; +begin + if assigned(GlobalCEFApp) then + result := GlobalCEFApp.DeviceScaleFactor + else + result := 1; + + TempHandle := FmxHandleToHWND(Handle); + + if (TempHandle <> 0) then + Result := GetWndScale(TempHandle); +end; + procedure TMainForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); var PositionChanged: Boolean; @@ -934,6 +951,7 @@ var TempPenInfo : POINTER_PEN_INFO; TempTouchEvent : TCefTouchEvent; TempPointF : TPointF; + TempScale : single; begin Result := False; if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit; @@ -980,10 +998,11 @@ begin if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPointF.x := TempPenInfo.pointerInfo.ptPixelLocation.x; - TempPointF.y := TempPenInfo.pointerInfo.ptPixelLocation.y; + TempScale := RealScreenScale; + TempPointF.x := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPointF.y := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.y, TempScale); + TempPointF := Panel1.ScreenToLocal(TempPointF); - // ScreenToLocal applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. TempTouchEvent.x := round(TempPointF.x); TempTouchEvent.y := round(TempPointF.y); @@ -995,6 +1014,7 @@ var TempTouchInfo : POINTER_TOUCH_INFO; TempTouchEvent : TCefTouchEvent; TempPointF : TPointF; + TempScale : single; begin Result := False; if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit; @@ -1029,10 +1049,11 @@ begin if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPointF.x := TempTouchInfo.pointerInfo.ptPixelLocation.x; - TempPointF.y := TempTouchInfo.pointerInfo.ptPixelLocation.y; + TempScale := RealScreenScale; + TempPointF.x := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPointF.y := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.y, TempScale); + TempPointF := Panel1.ScreenToLocal(TempPointF); - // ScreenToLocal applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. TempTouchEvent.x := round(TempPointF.x); TempTouchEvent.y := round(TempPointF.y); diff --git a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/FMXTabbedOSRBrowser.dproj b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/FMXTabbedOSRBrowser.dproj index 3bf2a614..ff918434 100644 --- a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/FMXTabbedOSRBrowser.dproj +++ b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/FMXTabbedOSRBrowser.dproj @@ -1,7 +1,7 @@  {7AA2E07C-ACFB-4174-A9F1-083E9BB483BC} - 19.3 + 19.4 FMX FMXTabbedOSRBrowser.dpr True @@ -281,14 +281,13 @@ - + true - - - FMXTabbedOSRBrowser.exe + + true @@ -297,8 +296,9 @@ true - - + + + FMXTabbedOSRBrowser.exe true @@ -1383,17 +1383,17 @@ 1 - - - - - - + - + + + + + + False diff --git a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas index 47b927d6..52840806 100644 --- a/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas +++ b/demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/uBrowserFrame.pas @@ -496,11 +496,11 @@ var TempScale : single; begin TempScale := FMXBufferPanel1.ScreenScale; - TempViewPt.x := LogicalToDevice(viewX, TempScale); - TempViewPt.y := LogicalToDevice(viewY, TempScale); + TempViewPt.x := viewX; + TempViewPt.y := viewY; TempScreenPt := FMXBufferPanel1.ClientToScreen(TempViewPt); - screenX := TempScreenPt.x; - screenY := TempScreenPt.y; + screenX := LogicalToDevice(TempScreenPt.x, TempScale); + screenY := LogicalToDevice(TempScreenPt.y, TempScale); Result := True; end; @@ -903,6 +903,7 @@ var TempPenInfo : POINTER_PEN_INFO; TempTouchEvent : TCefTouchEvent; TempPoint : TPoint; + TempScale : single; begin Result := False; @@ -950,8 +951,11 @@ begin if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPoint := FMXBufferPanel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempScale := FMXBufferPanel1.ScreenScale; + TempPoint.x := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPoint.y := DeviceToLogical(TempPenInfo.pointerInfo.ptPixelLocation.y, TempScale); + + TempPoint := FMXBufferPanel1.ScreenToClient(TempPoint); TempTouchEvent.x := TempPoint.x; TempTouchEvent.y := TempPoint.y; @@ -963,6 +967,7 @@ var TempTouchInfo : POINTER_TOUCH_INFO; TempTouchEvent : TCefTouchEvent; TempPoint : TPoint; + TempScale : single; begin Result := False; @@ -998,8 +1003,11 @@ begin if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then TempTouchEvent.type_ := CEF_TET_CANCELLED; - TempPoint := FMXBufferPanel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation); - // TFMXBufferPanel.ScreenToClient applies the scale factor. No need to call DeviceToLogical to set TempTouchEvent. + TempScale := FMXBufferPanel1.ScreenScale; + TempPoint.x := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.x, TempScale); + TempPoint.y := DeviceToLogical(TempTouchInfo.pointerInfo.ptPixelLocation.y, TempScale); + + TempPoint := FMXBufferPanel1.ScreenToClient(TempPoint); TempTouchEvent.x := TempPoint.x; TempTouchEvent.y := TempPoint.y; diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index 43d87076..b7849a48 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 418, + "InternalVersion" : 419, "Name" : "cef4delphi_lazarus.lpk", "Version" : "103.0.12.0" }