pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +02:00
Code Issues Actions Releases Activity

Added touch support for Windows 8,8.1,10 to FMXExternalPumpBrowser

Browse Source 
- Removed GestureBrowser demo
- Added TBufferPanel.OnWrongSize event
- Added TFMXBufferPanel.OnWrongSize event
- More touch support fixes in SimpleOSRBrowser and KioskOSRBrowser.
This commit is contained in:
Salvador Díaz Fau 2020-02-08 12:59:59 +01:00
parent 75258ea8e7
commit e8d2db5b57
19 changed files with 289 additions and 2005 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
demos/Delphi_FMX/FMXExternalPumpBrowser/uFMXApplicationService.pas
View File

@ -198,6 +198,14 @@ begin
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandleSYSKEYUP(TempMsg);
WM_POINTERDOWN,
WM_POINTERUPDATE,
WM_POINTERUP :
if not(Application.Terminated) and
(Application.MainForm <> nil) and
(Application.MainForm is TFMXExternalPumpBrowserFrm) then
TFMXExternalPumpBrowserFrm(Application.MainForm).HandlePOINTER(TempMsg);
CEF_PENDINGRESIZE :
if not(Application.Terminated) and
(Application.MainForm <> nil) and

1
demos/Delphi_FMX/FMXExternalPumpBrowser/uFMXExternalPumpBrowser.fmx
View File

@ -103,6 +103,7 @@ object FMXExternalPumpBrowserFrm: TFMXExternalPumpBrowserFrm
OnMouseWheel = Panel1MouseWheel
OnKeyUp = Panel1KeyUp
OnKeyDown = Panel1KeyDown
OnWrongSize = Panel1WrongSize
end
object chrmosr: TFMXChromium
OnTooltip = chrmosrTooltip

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

@ -80,6 +80,7 @@ type
procedure Panel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
procedure Panel1KeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure Panel1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure Panel1WrongSize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -113,6 +114,7 @@ type
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
FAtLeastWin8 : boolean;
{$IFDEF DELPHI17_UP}
FMouseWheelService : IFMXMouseService;
{$ENDIF}
@ -129,6 +131,10 @@ type
procedure InitializeLastClick;
function CancelPreviousClick(const x, y : single; var aCurrentTime : integer) : boolean;
function SendCompMessage(aMsg : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean;
function ArePointerEventsSupported : boolean;
function HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
function HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean; overload;
function HandlePointerEvent(const aMessage : TMsg) : boolean;
public
procedure DoResize;
@ -137,6 +143,7 @@ type
procedure HandleSYSCHAR(const aMessage : TMsg);
procedure HandleSYSKEYDOWN(const aMessage : TMsg);
procedure HandleSYSKEYUP(const aMessage : TMsg);
function HandlePOINTER(const aMessage : TMsg) : boolean;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
end;
@ -216,6 +223,8 @@ begin
end;
procedure TFMXExternalPumpBrowserFrm.FormCreate(Sender: TObject);
var
TempMajorVer, TempMinorVer : DWORD;
begin
TFMXApplicationService.AddPlatformService;
@ -228,6 +237,14 @@ begin
FClosing := False;
FResizeCS := TCriticalSection.Create;
{$IFDEF MSWINDOWS}
FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
((TempMajorVer > 6) or
((TempMajorVer = 6) and (TempMinorVer >= 2)));
{$ELSE}
FAtLeastWin8 := False;
{$ENDIF}
chrmosr.DefaultURL := AddressEdt.Text;
InitializeLastClick;
@ -390,7 +407,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
Panel1.SetFocus;
@ -462,7 +479,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
@ -480,7 +497,7 @@ procedure TFMXExternalPumpBrowserFrm.Panel1MouseUp(Sender : TObject;
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
TempEvent.x := round(X);
TempEvent.y := round(Y);
@ -511,6 +528,11 @@ begin
DoResize;
end;
procedure TFMXExternalPumpBrowserFrm.Panel1WrongSize(Sender: TObject);
begin
DoResize;
end;
procedure TFMXExternalPumpBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
@ -929,6 +951,160 @@ begin
end;
end;
function TFMXExternalPumpBrowserFrm.ArePointerEventsSupported : boolean;
begin
{$IFDEF MSWINDOWS}
Result := FAtLeastWin8 and
(@GetPointerType <> nil) and
(@GetPointerTouchInfo <> nil) and
(@GetPointerPenInfo <> nil);
{$ELSE}
Result := False;
{$ENDIF}
end;
function TFMXExternalPumpBrowserFrm.HandlePOINTER(const aMessage : TMsg) : boolean;
begin
Result := Panel1.IsFocused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
function TFMXExternalPumpBrowserFrm.HandlePointerEvent(const aMessage : TMsg) : boolean;
{$IFDEF MSWINDOWS}
const
PT_TOUCH = 2;
PT_PEN = 3;
var
TempID : uint32;
TempType : POINTER_INPUT_TYPE;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
TempID := LoWord(aMessage.wParam);
if GetPointerType(TempID, @TempType) then
case TempType of
PT_PEN : Result := HandlePenEvent(TempID, aMessage.message);
PT_TOUCH : Result := HandleTouchEvent(TempID, aMessage.message);
end;
{$ENDIF}
end;
function TFMXExternalPumpBrowserFrm.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
{$IFDEF MSWINDOWS}
var
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
if not(GetPointerPenInfo(aID, @TempPenInfo)) then exit;
TempTouchEvent.id := aID;
TempTouchEvent.x := 0;
TempTouchEvent.y := 0;
TempTouchEvent.radius_x := 0;
TempTouchEvent.radius_y := 0;
TempTouchEvent.type_ := CEF_TET_RELEASED;
TempTouchEvent.modifiers := EVENTFLAG_NONE;
if ((TempPenInfo.penFlags and PEN_FLAG_ERASER) <> 0) then
TempTouchEvent.pointer_type := CEF_POINTER_TYPE_ERASER
else
TempTouchEvent.pointer_type := CEF_POINTER_TYPE_PEN;
if ((TempPenInfo.penMask and PEN_MASK_PRESSURE) <> 0) then
TempTouchEvent.pressure := TempPenInfo.pressure / 1024
else
TempTouchEvent.pressure := 0;
if ((TempPenInfo.penMask and PEN_MASK_ROTATION) <> 0) then
TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * Pi
else
TempTouchEvent.rotation_angle := 0;
Result := True;
case aMsg of
WM_POINTERDOWN :
TempTouchEvent.type_ := CEF_TET_PRESSED;
WM_POINTERUPDATE :
if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then
TempTouchEvent.type_ := CEF_TET_MOVED
else
exit; // Ignore hover events.
WM_POINTERUP :
TempTouchEvent.type_ := CEF_TET_RELEASED;
end;
if ((TempPenInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempPoint := Panel1.ScreenToClient(TempPenInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendTouchEvent(@TempTouchEvent);
{$ENDIF}
end;
function TFMXExternalPumpBrowserFrm.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean;
{$IFDEF MSWINDOWS}
var
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
if not(GetPointerTouchInfo(aID, @TempTouchInfo)) then exit;
TempTouchEvent.id := aID;
TempTouchEvent.x := 0;
TempTouchEvent.y := 0;
TempTouchEvent.radius_x := 0;
TempTouchEvent.radius_y := 0;
TempTouchEvent.rotation_angle := 0;
TempTouchEvent.pressure := 0;
TempTouchEvent.type_ := CEF_TET_RELEASED;
TempTouchEvent.modifiers := EVENTFLAG_NONE;
TempTouchEvent.pointer_type := CEF_POINTER_TYPE_TOUCH;
Result := True;
case aMsg of
WM_POINTERDOWN :
TempTouchEvent.type_ := CEF_TET_PRESSED;
WM_POINTERUPDATE :
if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_INCONTACT) <> 0) then
TempTouchEvent.type_ := CEF_TET_MOVED
else
exit; // Ignore hover events.
WM_POINTERUP :
TempTouchEvent.type_ := CEF_TET_RELEASED;
end;
if ((TempTouchInfo.pointerInfo.pointerFlags and POINTER_FLAG_CANCELED) <> 0) then
TempTouchEvent.type_ := CEF_TET_CANCELLED;
TempPoint := Panel1.ScreenToClient(TempTouchInfo.pointerInfo.ptPixelLocation);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
chrmosr.SendTouchEvent(@TempTouchEvent);
{$ENDIF}
end;
function TFMXExternalPumpBrowserFrm.getModifiers(Shift: TShiftState): TCefEventFlags;
begin
Result := EVENTFLAG_NONE;

17
demos/Delphi_FMX/FMXToolBoxBrowser/uChildForm.pas
View File

@ -181,20 +181,25 @@ begin
WM_WINDOWPOSCHANGING :
begin
TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos;
if ((TempWindowPos.Flags and SWP_STATECHANGED) = SWP_STATECHANGED) then
if ((TempWindowPos.Flags and SWP_STATECHANGED) <> 0) then
UpdateCustomWindowState;
end;
WM_SHOWWINDOW :
if (aMessage.wParam <> 0) and (aMessage.lParam = SW_PARENTOPENING) then
PostCustomMessage(CEF_SHOWBROWSER);
CEF_DESTROY :
if (FMXWindowParent <> nil) then
FreeAndNil(FMXWindowParent);
CEF_SHOWBROWSER :
begin
FMXWindowParent.WindowState := TWindowState.wsNormal;
FMXWindowParent.Show;
FMXWindowParent.SetBounds(GetFMXWindowParentRect);
end;
if (FMXWindowParent <> nil) then
begin
FMXWindowParent.WindowState := TWindowState.wsNormal;
FMXWindowParent.Show;
FMXWindowParent.SetBounds(GetFMXWindowParentRect);
end;
end;
aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam);

22
demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas
View File

@ -48,12 +48,13 @@ uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
FMX.Edit, FMX.Controls.Presentation, uCEFFMXWindowParent, uCEFFMXChromium,
System.SyncObjs,
uCEFInterfaces, uCEFConstants, uCEFTypes, uCEFChromiumCore, FMX.Layouts;
const
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS = MENU_ID_USER_FIRST + 1;
CEF_SHOWBROWSER = WM_APP + $101;
CEF_SHOWBROWSER = WM_APP + $101;
type
TSimpleFMXBrowserFrm = class(TForm)
@ -293,10 +294,14 @@ begin
WM_WINDOWPOSCHANGING :
begin
TempWindowPos := TWMWindowPosChanging(aMessage).WindowPos;
if ((TempWindowPos.Flags and SWP_STATECHANGED) = SWP_STATECHANGED) then
if ((TempWindowPos.Flags and SWP_STATECHANGED) <> 0) then
UpdateCustomWindowState;
end;
WM_SHOWWINDOW :
if (aMessage.wParam <> 0) and (aMessage.lParam = SW_PARENTOPENING) then
PostCustomMessage(CEF_SHOWBROWSER);
CEF_AFTERCREATED :
begin
Caption := 'Simple FMX Browser';
@ -308,11 +313,12 @@ begin
FreeAndNil(FMXWindowParent);
CEF_SHOWBROWSER :
begin
FMXWindowParent.WindowState := TWindowState.wsNormal;
FMXWindowParent.Show;
FMXWindowParent.SetBounds(GetFMXWindowParentRect);
end;
if (FMXWindowParent <> nil) then
begin
FMXWindowParent.WindowState := TWindowState.wsNormal;
FMXWindowParent.Show;
FMXWindowParent.SetBounds(GetFMXWindowParentRect);
end;
end;
aMessage.Result := CallWindowProc(FOldWndPrc, FmxHandleToHWND(Handle), aMessage.Msg, aMessage.wParam, aMessage.lParam);
@ -358,6 +364,8 @@ begin
SW_SHOWMAXIMIZED : Result := TWindowState.wsMaximized;
SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized;
end;
if IsIconic(TempHWND) then Result := TWindowState.wsMinimized;
end;
{$ENDIF}

18
demos/Delphi_VCL/GestureBrowser/00-DeleteDCUs.bat
View File

@ -1,18 +0,0 @@
del /s /q *.dcu
del /s /q *.exe
del /s /q *.res
del /s /q *.rsm
del /s /q *.log
del /s /q *.dsk
del /s /q *.identcache
del /s /q *.stat
del /s /q *.local
del /s /q *.~*
rmdir Win32\Debug
rmdir Win32\Release
rmdir Win32
rmdir Win64\Debug
rmdir Win64\Release
rmdir Win64
rmdir __history
rmdir __recovery

73
demos/Delphi_VCL/GestureBrowser/GestureBrowser.dpr
View File

@ -1,73 +0,0 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2018 Salvador Díaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
program GestureBrowser;
{$I cef.inc}
uses
{$IFDEF DELPHI16_UP}
Vcl.Forms,
WinApi.Windows,
{$ELSE}
Forms,
Windows,
{$ENDIF }
uCEFApplication, uCEFConstants,
uGestureBrowser in 'uGestureBrowser.pas' {Form1};
{$R *.res}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
// If you don't add this flag the rederer process will crash when you try to load large images.
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
GlobalCEFApp := TCefApplication.Create;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
{$IFDEF DELPHI11_UP}
Application.MainFormOnTaskbar := True;
{$ENDIF}
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
DestroyGlobalCEFApp;
end.

1056
demos/Delphi_VCL/GestureBrowser/GestureBrowser.dproj
View File

File diff suppressed because it is too large Load Diff

409
demos/Delphi_VCL/GestureBrowser/cef.inc
View File

@ -1,409 +0,0 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2017 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
// The complete list of compiler versions is here :
// http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Compiler_Versions
{$DEFINE DELPHI_VERSION_UNKNOW}
// Delphi 5
{$IFDEF VER130}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$ENDIF}
// Delphi 6
{$IFDEF VER140}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$ENDIF}
// Delphi 7
{$IFDEF VER150}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$ENDIF}
// Delphi 8
{$IFDEF VER160}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$ENDIF}
// Delphi 2005
{$IFDEF VER170}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$ENDIF}
{$IFDEF VER180}
{$UNDEF DELPHI_VERSION_UNKNOW}
// Delphi 2007
{$IFDEF VER185}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
// Delphi 2006
{$ELSE}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$ENDIF}
{$ENDIF}
// Delphi 2009
{$IFDEF VER200}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$ENDIF}
//Delphi 2010
{$IFDEF VER210}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$ENDIF}
// Delphi XE
{$IFDEF VER220}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$ENDIF}
// Delphi XE2 (First FireMonkey and 64bit compiler)
{$IFDEF VER230}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$ENDIF}
// Delphi XE3
{$IFDEF VER240}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$ENDIF}
// Delphi XE4
{$IFDEF VER250}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$ENDIF}
// Delphi XE5
{$IFDEF VER260}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$ENDIF}
// Delphi XE6
{$IFDEF VER270}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$ENDIF}
// Delphi XE7
{$IFDEF VER280}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$ENDIF}
// Delphi XE8
{$IFDEF VER290}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$ENDIF VER290}
// Rad Studio 10 - Delphi Seattle
{$IFDEF VER300}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$ENDIF}
// Rad Studio 10.1 - Delphi Berlin
{$IFDEF VER310}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$ENDIF}
// Rad Studio 10.2 - Delphi Tokyo
{$IFDEF VER320}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$ENDIF}
// Rad Studio 10.3 - Delphi Rio
{$IFDEF VER330}
{$UNDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE SUPPORTS_INLINE}
{$ELSE}
{$IFDEF DELPHI_VERSION_UNKNOW}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI8_UP}
{$DEFINE DELPHI9_UP}
{$DEFINE DELPHI10_UP}
{$DEFINE DELPHI11_UP}
{$DEFINE DELPHI12_UP}
{$DEFINE DELPHI14_UP}
{$DEFINE DELPHI15_UP}
{$DEFINE DELPHI16_UP}
{$DEFINE DELPHI17_UP}
{$DEFINE DELPHI18_UP}
{$DEFINE DELPHI19_UP}
{$DEFINE DELPHI20_UP}
{$DEFINE DELPHI21_UP}
{$DEFINE DELPHI22_UP}
{$DEFINE DELPHI23_UP}
{$DEFINE DELPHI24_UP}
{$DEFINE DELPHI25_UP}
{$DEFINE DELPHI26_UP}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI9_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}

98
demos/Delphi_VCL/GestureBrowser/uGestureBrowser.dfm
View File

@ -1,98 +0,0 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Initializing browser. Please wait...'
ClientHeight = 624
ClientWidth = 1038
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object AddressPnl: TPanel
Left = 0
Top = 0
Width = 1038
Height = 30
Align = alTop
BevelOuter = bvNone
Enabled = False
Padding.Left = 5
Padding.Top = 5
Padding.Right = 5
Padding.Bottom = 5
TabOrder = 0
object AddressEdt: TEdit
Left = 5
Top = 5
Width = 997
Height = 20
Margins.Right = 5
Align = alClient
TabOrder = 0
Text = 'http://www.google.com'
ExplicitHeight = 21
end
object GoBtn: TButton
Left = 1002
Top = 5
Width = 31
Height = 20
Margins.Left = 5
Align = alRight
Caption = 'Go'
TabOrder = 1
OnClick = GoBtnClick
end
end
object CEFWindowParent1: TCEFWindowParent
Left = 0
Top = 30
Width = 1038
Height = 594
Align = alClient
TabOrder = 1
Touch.GestureManager = GestureManager1
OnGesture = CEFWindowParent1Gesture
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 56
Top = 88
end
object Chromium1: TChromium
OnRenderCompMsg = Chromium1RenderCompMsg
OnBeforePopup = Chromium1BeforePopup
OnAfterCreated = Chromium1AfterCreated
OnBeforeClose = Chromium1BeforeClose
OnClose = Chromium1Close
OnOpenUrlFromTab = Chromium1OpenUrlFromTab
Left = 56
Top = 152
end
object GestureManager1: TGestureManager
Left = 56
Top = 216
GestureData = <
item
Control = CEFWindowParent1
Collection = <
item
GestureID = sgiLeft
end
item
GestureID = sgiRight
end>
end>
end
end

284
demos/Delphi_VCL/GestureBrowser/uGestureBrowser.pas
View File

@ -1,284 +0,0 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uGestureBrowser;
{$I cef.inc}
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Touch.GestureMgr,
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
uCEFWinControl, uCEFSentinel, uCEFChromiumCore;
type
TForm1 = class(TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
GoBtn: TButton;
Timer1: TTimer;
Chromium1: TChromium;
CEFWindowParent1: TCEFWindowParent;
GestureManager1: TGestureManager;
procedure GoBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser;
var aAction : TCefCloseBrowserAction);
procedure Chromium1BeforeClose(Sender: TObject;
const browser: ICefBrowser);
procedure Chromium1BeforePopup(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
targetFrameName: ustring;
targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean;
const popupFeatures: TCefPopupFeatures;
var windowInfo: TCefWindowInfo; var client: ICefClient;
var settings: TCefBrowserSettings;
var extra_info: ICefDictionaryValue; var noJavascriptAccess,
Result: Boolean);
procedure Chromium1OpenUrlFromTab(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring;
targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean;
out Result: Boolean);
procedure Chromium1RenderCompMsg(var aMessage: TMessage;
var aHandled: Boolean);
procedure CEFWindowParent1Gesture(Sender: TObject;
const EventInfo: TGestureEventInfo; var Handled: Boolean);
protected
// Variables to control when can we destroy the form safely
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
// You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
// You also have to handle these two messages to set GlobalCEFApp.OsmodalLoop
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
uCEFApplication, uCefMiscFunctions;
// This demo shows how to use touch/mouse gestures with a TChromium and
// TCEFWindowParent.
// It uses a TGestureManager which means that it needs Delphi 2010 or newer.
// This demo intercepts the mouse and touch related messages in the
// TChromium.OnRenderCompMsg event and sends them to TCEFWindowParent which
// has a linked TGestureManager.
// Enable the touch gestures you need in the TCEFWindowParent.Touch property
// and use the TCEFWindowParent.OnGesture event to handle them.
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which
// triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy
// CEFWindowParent1 in the main thread, which triggers the
// TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the
// form.
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
Chromium1.CloseBrowser(True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
Chromium1.DefaultURL := AddressEdt.Text;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
// You *MUST* call CreateBrowser to create and initialize the browser.
// This will trigger the AfterCreated event when the browser is fully
// initialized and ready to receive commands.
// GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser
// If it's not initialized yet, we use a simple timer to create the browser later.
if not(Chromium1.CreateBrowser(CEFWindowParent1)) then Timer1.Enabled := True;
end;
procedure TForm1.CEFWindowParent1Gesture(Sender: TObject;
const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
case EventInfo.GestureID of
sgiLeft : Chromium1.GoBack;
sgiRight : Chromium1.GoForward;
end;
end;
procedure TForm1.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
// Now the browser is fully initialized we can send a message to the main form to load the initial web page.
PostMessage(Handle, CEF_AFTERCREATED, 0, 0);
end;
procedure TForm1.Chromium1BeforeClose(Sender: TObject;
const browser: ICefBrowser);
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
procedure TForm1.Chromium1BeforePopup(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; const popupFeatures: TCefPopupFeatures;
var windowInfo: TCefWindowInfo; var client: ICefClient;
var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
var noJavascriptAccess, Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TForm1.Chromium1Close(Sender: TObject;
const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
begin
PostMessage(Handle, CEF_DESTROY, 0, 0);
aAction := cbaDelay;
end;
procedure TForm1.Chromium1OpenUrlFromTab(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; out Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TForm1.Chromium1RenderCompMsg(var aMessage: TMessage;
var aHandled: Boolean);
begin
if FClosing then exit;
case aMessage.Msg of
WM_MOUSEFIRST..WM_MOUSELAST,
WM_TOUCH,
WM_GESTURE,
WM_GESTURENOTIFY :
PostMessage(CEFWindowParent1.Handle, aMessage.Msg, aMessage.wParam, aMessage.lParam);
end;
end;
procedure TForm1.BrowserCreatedMsg(var aMessage : TMessage);
begin
Caption := 'Gesture Browser';
AddressPnl.Enabled := True;
end;
procedure TForm1.BrowserDestroyMsg(var aMessage : TMessage);
begin
CEFWindowParent1.Free;
end;
procedure TForm1.GoBtnClick(Sender: TObject);
begin
// This will load the URL in the edit box
Chromium1.LoadURL(AddressEdt.Text);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1)) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TForm1.WMMove(var aMessage : TWMMove);
begin
inherited;
if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TForm1.WMMoving(var aMessage : TMessage);
begin
inherited;
if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TForm1.WMEnterMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True;
end;
procedure TForm1.WMExitMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False;
end;
end.

1
demos/Delphi_VCL/KioskOSRBrowser/uKioskOSRBrowser.dfm
View File

@ -31,6 +31,7 @@ object Form1: TForm1
OnPointerDown = Panel1PointerDown
OnPointerUp = Panel1PointerUp
OnPointerUpdate = Panel1PointerUpdate
OnWrongSize = Panel1WrongSize
Align = alClient
Caption = 'Panel1'
TabOrder = 0

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

@ -89,6 +89,7 @@ type
procedure Panel1PointerDown(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1PointerUp(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1PointerUpdate(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1WrongSize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -120,6 +121,7 @@ type
FCanClose : boolean;
FClosing : boolean;
FResizeCS : TCriticalSection;
FAtLeastWin8 : boolean;
FLastClickCount : integer;
FLastClickTime : integer;
@ -131,7 +133,6 @@ type
procedure DoResize;
procedure InitializeLastClick;
function CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean;
function AtLeastWin8 : boolean;
function ArePointerEventsSupported : boolean;
function HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
function HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean;
@ -681,6 +682,8 @@ begin
end;
procedure TForm1.FormCreate(Sender: TObject);
var
TempMajorVer, TempMinorVer : DWORD;
begin
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
@ -691,6 +694,10 @@ begin
FClosing := False;
FResizeCS := TCriticalSection.Create;
FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
((TempMajorVer > 6) or
((TempMajorVer = 6) and (TempMinorVer >= 2)));
InitializeLastClick;
if (GlobalCEFApp <> nil) and
@ -749,7 +756,6 @@ var
i : integer;
TempTouchInputs : array of TTouchInput;
TempPoint : TPoint;
TempAtLeastWin8 : boolean;
TempLParam : LPARAM;
TempResult : LRESULT;
begin
@ -765,14 +771,12 @@ begin
if GetTouchInputInfo(TempHTOUCHINPUT, TempNumPoints, @TempTouchInputs[0], SizeOf(TTouchInput)) then
begin
TempAtLeastWin8 := AtLeastWin8;
i := 0;
while (i < TempNumPoints) do
begin
TempPoint := TouchPointToPoint(Panel1.Handle, TempTouchInputs[i]);
if not(TempAtLeastWin8) then
if not(FAtLeastWin8) then
begin
// Windows 7 sends touch events for touches in the non-client area,
// whereas Windows 8 does not. In order to unify the behaviour, always
@ -823,7 +827,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
Panel1.SetFocus;
@ -873,7 +877,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
@ -889,7 +893,7 @@ procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TSh
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
TempEvent.x := X;
TempEvent.y := Y;
@ -928,6 +932,11 @@ begin
DoResize;
end;
procedure TForm1.Panel1WrongSize(Sender: TObject);
begin
DoResize;
end;
procedure TForm1.PendingResizeMsg(var aMessage : TMessage);
begin
DoResize;
@ -983,20 +992,12 @@ end;
function TForm1.ArePointerEventsSupported : boolean;
begin
Result := (@GetPointerType <> nil) and
Result := FAtLeastWin8 and
(@GetPointerType <> nil) and
(@GetPointerTouchInfo <> nil) and
(@GetPointerPenInfo <> nil);
end;
function TForm1.AtLeastWin8 : boolean;
var
TempMajorVer, TempMinorVer : DWORD;
begin
Result := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
((TempMajorVer > 6) or
((TempMajorVer = 6) and (TempMinorVer >= 2)));
end;
function TForm1.HandlePointerEvent(var aMessage : TMessage) : boolean;
const
PT_TOUCH = 2;
@ -1044,7 +1045,7 @@ begin
TempTouchEvent.pressure := 0;
if ((TempPenInfo.penMask and PEN_MASK_ROTATION) <> 0) then
TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * 3.14159
TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * Pi
else
TempTouchEvent.rotation_angle := 0;

1
demos/Delphi_VCL/SimpleOSRBrowser/uSimpleOSRBrowser.dfm
View File

@ -114,6 +114,7 @@ object Form1: TForm1
OnPointerUp = Panel1PointerUp
OnPointerUpdate = Panel1PointerUpdate
OnPaintParentBkg = Panel1PaintParentBkg
OnWrongSize = Panel1WrongSize
Align = alClient
Ctl3D = False
ParentCtl3D = False

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

@ -92,6 +92,7 @@ type
procedure Panel1PointerDown(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1PointerUp(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1PointerUpdate(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
procedure Panel1WrongSize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -131,6 +132,7 @@ type
FIMECS : TCriticalSection;
FDeviceBounds : TCefRectDynArray;
FSelectedRange : TCefRange;
FAtLeastWin8 : boolean;
FLastClickCount : integer;
FLastClickTime : integer;
@ -142,7 +144,6 @@ type
procedure DoResize;
procedure InitializeLastClick;
function CancelPreviousClick(x, y : integer; var aCurrentTime : integer) : boolean;
function AtLeastWin8 : boolean;
function ArePointerEventsSupported : boolean;
function HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
function HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean;
@ -676,6 +677,8 @@ begin
end;
procedure TForm1.FormCreate(Sender: TObject);
var
TempMajorVer, TempMinorVer : DWORD;
begin
FPopUpBitmap := nil;
FPopUpRect := rect(0, 0, 0, 0);
@ -686,6 +689,10 @@ begin
FClosing := False;
FDeviceBounds := nil;
FAtLeastWin8 := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
((TempMajorVer > 6) or
((TempMajorVer = 6) and (TempMinorVer >= 2)));
FSelectedRange.from := 0;
FSelectedRange.to_ := 0;
@ -762,7 +769,6 @@ var
i : integer;
TempTouchInputs : array of TTouchInput;
TempPoint : TPoint;
TempAtLeastWin8 : boolean;
TempLParam : LPARAM;
TempResult : LRESULT;
begin
@ -778,14 +784,12 @@ begin
if GetTouchInputInfo(TempHTOUCHINPUT, TempNumPoints, @TempTouchInputs[0], SizeOf(TTouchInput)) then
begin
TempAtLeastWin8 := AtLeastWin8;
i := 0;
while (i < TempNumPoints) do
begin
TempPoint := TouchPointToPoint(Panel1.Handle, TempTouchInputs[i]);
if not(TempAtLeastWin8) then
if not(FAtLeastWin8) then
begin
// Windows 7 sends touch events for touches in the non-client area,
// whereas Windows 8 does not. In order to unify the behaviour, always
@ -836,7 +840,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
Panel1.SetFocus;
@ -886,7 +890,7 @@ var
TempEvent : TCefMouseEvent;
TempTime : integer;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
if CancelPreviousClick(x, y, TempTime) then InitializeLastClick;
@ -902,7 +906,7 @@ procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TSh
var
TempEvent : TCefMouseEvent;
begin
if (GlobalCEFApp <> nil) and (chrmosr <> nil) then
if (GlobalCEFApp <> nil) and (chrmosr <> nil) and not(ssTouch in Shift) then
begin
TempEvent.x := X;
TempEvent.y := Y;
@ -998,7 +1002,7 @@ begin
TempTouchEvent.pressure := 0;
if ((TempPenInfo.penMask and PEN_MASK_ROTATION) <> 0) then
TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * 3.14159
TempTouchEvent.rotation_angle := TempPenInfo.rotation / 180 * Pi
else
TempTouchEvent.rotation_angle := 0;
@ -1080,6 +1084,11 @@ begin
DoResize;
end;
procedure TForm1.Panel1WrongSize(Sender: TObject);
begin
DoResize;
end;
procedure TForm1.PendingResizeMsg(var aMessage : TMessage);
begin
DoResize;
@ -1135,20 +1144,12 @@ end;
function TForm1.ArePointerEventsSupported : boolean;
begin
Result := (@GetPointerType <> nil) and
Result := FAtLeastWin8 and
(@GetPointerType <> nil) and
(@GetPointerTouchInfo <> nil) and
(@GetPointerPenInfo <> nil);
end;
function TForm1.AtLeastWin8 : boolean;
var
TempMajorVer, TempMinorVer : DWORD;
begin
Result := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
((TempMajorVer > 6) or
((TempMajorVer = 6) and (TempMinorVer >= 2)));
end;
procedure TForm1.Panel1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(True);

7
demos/Lazarus/CookieVisitor/CookieVisitor.lps
View File

@ -20,6 +20,7 @@
<ComponentName Value="CookieVisitorFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="145"/>
<CursorPos X="41" Y="166"/>
@ -84,12 +85,10 @@
</Unit7>
<Unit8>
<Filename Value="..\..\..\source\uCEFMiscFunctions.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<EditorIndex Value="-1"/>
<TopLine Value="249"/>
<CursorPos X="5" Y="263"/>
<CursorPos X="61" Y="272"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit8>
</Units>
<JumpHistory Count="24" HistoryIndex="23">

25
source/uCEFBufferPanel.pas
View File

@ -75,6 +75,7 @@ type
FScanlineSize : integer;
FTransparent : boolean;
FOnPaintParentBkg : TNotifyEvent;
FOnWrongSize : TNotifyEvent;
{$IFDEF MSWINDOWS}
FIMEHandler : TCEFOSRIMEHandler;
FOnIMECancelComposition : TNotifyEvent;
@ -149,6 +150,7 @@ type
property OnPointerUpdate : TOnHandledMessageEvent read FOnPointerUpdate write FOnPointerUpdate;
{$ENDIF}
property OnPaintParentBkg : TNotifyEvent read FOnPaintParentBkg write FOnPaintParentBkg;
property OnWrongSize : TNotifyEvent read FOnWrongSize write FOnWrongSize;
property Transparent : boolean read FTransparent write SetTransparent default False;
@ -255,9 +257,11 @@ constructor TBufferPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMutex := 0;
FBuffer := nil;
FTransparent := False;
FMutex := 0;
FBuffer := nil;
FTransparent := False;
FOnPaintParentBkg := nil;
FOnWrongSize := nil;
{$IFDEF MSWINDOWS}
FIMEHandler := nil;
@ -390,12 +394,15 @@ begin
end;
function TBufferPanel.CopyBuffer : boolean;
{$IFDEF MSWINDOWS}
var
TempFunction : TBlendFunction;
{$ENDIF}
{$IFDEF MSWINDOWS}
TempFunction : TBlendFunction;
{$ENDIF}
TempWrongSize : boolean;
begin
Result := False;
Result := False;
TempWrongSize := False;
{$IFDEF MSWINDOWS}
if BeginBufferDraw then
try
@ -422,11 +429,15 @@ begin
Result := BitBlt(Canvas.Handle, 0, 0, Width, Height,
FBuffer.Canvas.Handle, 0, 0,
SrcCopy);
TempWrongSize := (Width <> FBuffer.Width) or (Height <> FBuffer.Height);
end;
finally
EndBufferDraw;
end;
{$ENDIF}
if TempWrongSize and assigned(FOnWrongSize) then FOnWrongSize(self);
end;
procedure TBufferPanel.Paint;

12
source/uCEFFMXBufferPanel.pas
View File

@ -69,6 +69,7 @@ type
FColor : TAlphaColor;
FHighSpeedDrawing : boolean;
FOnDialogKey : TDialogKeyEvent;
FOnWrongSize : TNotifyEvent;
procedure CreateSyncObj;
@ -147,6 +148,7 @@ type
property OnKeyUp;
property OnKeyDown;
property OnDialogKey : TDialogKeyEvent read FOnDialogKey write FOnDialogKey;
property OnWrongSize : TNotifyEvent read FOnWrongSize write FOnWrongSize;
end;
implementation
@ -168,6 +170,7 @@ begin
FScanlineSize := 0;
FColor := claWhite;
FOnDialogKey := nil;
FOnWrongSize := nil;
FHighSpeedDrawing := True;
end;
@ -277,8 +280,10 @@ function TFMXBufferPanel.CopyBuffer : boolean;
var
TempSrc, TempDst, TempClip : TRectF;
TempState : TCanvasSaveState;
TempWrongSize : boolean;
begin
Result := False;
Result := False;
TempWrongSize := False;
if Canvas.BeginScene then
try
@ -298,6 +303,9 @@ begin
finally
Canvas.RestoreState(TempState);
end;
TempWrongSize := (abs(Width - TempDst.Width) > 1) or
(abs(Height - TempDst.Height) > 1);
end;
finally
EndBufferDraw;
@ -305,6 +313,8 @@ begin
finally
Canvas.EndScene;
end;
if TempWrongSize and assigned(FOnWrongSize) then FOnWrongSize(self);
end;
procedure TFMXBufferPanel.DialogKey(var Key: Word; Shift: TShiftState);

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 95,
"InternalVersion" : 96,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "79.1.36.0"
}