Skip to content

Commit

Permalink
Fixed context menu position in Firemonkey OSR demos running in high D…
Browse files Browse the repository at this point in the history 
…PI monitors

Fixed touch and pen handling function in Firemonkey OSR demos running in high DPI monitors.
Fixed issue #431: Outdated DCPCrypt project link
  • Loading branch information
@salvadordf
salvadordf committed Jul 28, 2022
1 parent 394186d commit 9a1a3bb
Show file tree
Hide file tree
Showing 8 changed files with 120 additions and 84 deletions.
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
34 changes: 17 additions & 17 deletions demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/FMXExternalPumpBrowser.dproj
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{BE24D13B-2634-4064-8746-AB331419C5FA}</ProjectGuid>
<ProjectVersion>19.3</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>FMXExternalPumpBrowser.dpr</MainSource>
<Base>True</Base>
Expand Down Expand Up @@ -219,7 +219,7 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
Expand Down Expand Up @@ -276,9 +276,8 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="..\..\bin\FMXExternalPumpBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FMXExternalPumpBrowser.exe</RemoteName>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
Expand All @@ -292,11 +291,6 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgsqlite3.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
Expand All @@ -312,6 +306,12 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\..\bin\FMXExternalPumpBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FMXExternalPumpBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
Expand Down Expand Up @@ -1437,17 +1437,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Android">False</Platform>
Expand Down
57 changes: 32 additions & 25 deletions demos/Delphi_FMX_Windows/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -591,11 +591,11 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrGetScreenPoint( Sender : TObje
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;

Expand Down Expand Up @@ -811,25 +811,23 @@ procedure TFMXExternalPumpBrowserFrm.chrmosrTooltip( Sender : TObject;

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);
Expand Down Expand Up @@ -1064,6 +1062,7 @@ function TFMXExternalPumpBrowserFrm.HandlePenEvent(const aID : uint32; aMsg : ca
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit;
Expand Down Expand Up @@ -1110,8 +1109,11 @@ function TFMXExternalPumpBrowserFrm.HandlePenEvent(const aID : uint32; aMsg : ca
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;

Expand All @@ -1123,6 +1125,7 @@ function TFMXExternalPumpBrowserFrm.HandleTouchEvent(const aID : uint32; aMsg :
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
TempScale : single;
begin
Result := False;
if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit;
Expand Down Expand Up @@ -1157,8 +1160,12 @@ function TFMXExternalPumpBrowserFrm.HandleTouchEvent(const aID : uint32; aMsg :
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;

Expand Down
6 changes: 3 additions & 3 deletions demos/Delphi_FMX_Windows/FMXSkiaBrowser/FMXSkiaBrowser.dproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -219,7 +219,7 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
Expand Down Expand Up @@ -281,12 +281,12 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libpcre.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libpcre.dylib" Class="DependencyModule">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
Expand Down
51 changes: 36 additions & 15 deletions demos/Delphi_FMX_Windows/FMXSkiaBrowser/uMainForm.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,7 @@ TMainForm = class(TForm)
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;
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -681,6 +683,21 @@ procedure TMainForm.DoResize;
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;
Expand Down Expand Up @@ -934,6 +951,7 @@ function TMainForm.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPointF : TPointF;
TempScale : single;
begin
Result := False;
if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit;
Expand Down Expand Up @@ -980,10 +998,11 @@ function TMainForm.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean
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);

Expand All @@ -995,6 +1014,7 @@ function TMainForm.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boole
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPointF : TPointF;
TempScale : single;
begin
Result := False;
if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit;
Expand Down Expand Up @@ -1029,10 +1049,11 @@ function TMainForm.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boole
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);

Expand Down
28 changes: 14 additions & 14 deletions demos/Delphi_FMX_Windows/FMXTabbedOSRBrowser/FMXTabbedOSRBrowser.dproj
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7AA2E07C-ACFB-4174-A9F1-083E9BB483BC}</ProjectGuid>
<ProjectVersion>19.3</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>FMXTabbedOSRBrowser.dpr</MainSource>
<Base>True</Base>
Expand Down Expand Up @@ -281,14 +281,13 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libpcre.dylib" Class="DependencyModule">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\..\..\bin\FMXTabbedOSRBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FMXTabbedOSRBrowser.exe</RemoteName>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libpcre.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
Expand All @@ -297,8 +296,9 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<DeployFile LocalName="..\..\..\bin\FMXTabbedOSRBrowser.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FMXTabbedOSRBrowser.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
Expand Down Expand Up @@ -1383,17 +1383,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Android">False</Platform>
Expand Down
Loading

0 comments on commit 9a1a3bb

Please sign in to comment.