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 and pen support to SimpleOSRBrowser and KioskOSRBrowser demos

Browse Source 
- Added TBufferPanel.OnCustomTouch
- Added TBufferPanel.OnPointerDown
- Added TBufferPanel.OnPointerUp
- Added TBufferPanel.OnPointerUpdate
- Added TFMXWindowParent.Touch
- Added TFMXWindowParent.OnGesture
- Removed the gesture manager from the KioskOSRBrowser demo
This commit is contained in:
Salvador Díaz Fau 2020-02-03 12:02:30 +01:00
parent f324118a56
commit 1ca9ebf179
9 changed files with 621 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,6 +27,10 @@ object Form1: TForm1
Top = 0
Width = 1004
Height = 526
OnCustomTouch = Panel1CustomTouch
OnPointerDown = Panel1PointerDown
OnPointerUp = Panel1PointerUp
OnPointerUpdate = Panel1PointerUpdate
Align = alClient
Caption = 'Panel1'
TabOrder = 0
@ -39,8 +43,6 @@ object Form1: TForm1
OnMouseUp = Panel1MouseUp
OnResize = Panel1Resize
OnMouseLeave = Panel1MouseLeave
Touch.GestureManager = GestureManager1
OnGesture = Panel1Gesture
end
object TouchKeyboard1: TTouchKeyboard
Left = 0
@ -82,19 +84,4 @@ object Form1: TForm1
Left = 40
Top = 182
end
object GestureManager1: TGestureManager
Left = 40
Top = 256
GestureData = <
item
Control = Panel1
Collection = <
item
GestureID = sgiLeft
end
item
GestureID = sgiRight
end>
end>
end
end

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

@ -73,7 +73,6 @@ type
Timer1: TTimer;
Panel1: TBufferPanel;
TouchKeyboard1: TTouchKeyboard;
GestureManager1: TGestureManager;
procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
procedure Timer1Timer(Sender: TObject);
@ -86,6 +85,10 @@ type
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseLeave(Sender: TObject);
procedure Panel1CustomTouch(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
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 FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -107,8 +110,6 @@ type
procedure chrmosrBeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure chrmosrContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean);
procedure chrmosrVirtualKeyboardRequested(Sender: TObject; const browser: ICefBrowser; input_mode: TCefTextInpuMode);
procedure Panel1Gesture(Sender: TObject; const EventInfo: TGestureEventInfo;
var Handled: Boolean);
protected
FPopUpBitmap : TBitmap;
@ -130,6 +131,11 @@ 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;
function HandlePointerEvent(var aMessage : TMessage) : boolean;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
@ -178,6 +184,7 @@ begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.TouchEvents := STATE_ENABLED;
end;
procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
@ -685,6 +692,11 @@ begin
FResizeCS := TCriticalSection.Create;
InitializeLastClick;
if (GlobalCEFApp <> nil) and
(GlobalCEFApp.TouchEvents = STATE_ENABLED) and
Panel1.HandleAllocated then
RegisterTouchWindow(Panel1.Handle, 0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
@ -714,6 +726,9 @@ begin
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
chrmosr.DefaultURL := HOMEPAGE_URL;
if not(ArePointerEventsSupported) then
RegisterTouchWindow(Panel1.Handle, 0);
if chrmosr.CreateBrowser(nil, '') then
chrmosr.InitializeDragAndDrop(Panel1)
else
@ -726,12 +741,89 @@ begin
Panel1.SetFocus;
end;
procedure TForm1.Panel1CustomTouch(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
var
TempTouchEvent : TCefTouchEvent;
TempHTOUCHINPUT : HTOUCHINPUT;
TempNumPoints : integer;
i : integer;
TempTouchInputs : array of TTouchInput;
TempPoint : TPoint;
TempAtLeastWin8 : boolean;
TempLParam : LPARAM;
TempResult : LRESULT;
begin
if not(Panel1.Focused) or (GlobalCEFApp = nil) then exit;
TempNumPoints := LOWORD(aMessage.wParam);
// Chromium only supports upto 16 touch points.
if (TempNumPoints < 1) or (TempNumPoints > 16) then exit;
SetLength(TempTouchInputs, TempNumPoints);
TempHTOUCHINPUT := HTOUCHINPUT(aMessage.lParam);
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
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
// ignore touch events in the non-client area.
TempLParam := MakeLParam(TempPoint.x, TempPoint.y);
TempResult := SendMessage(Panel1.Handle, WM_NCHITTEST, 0, TempLParam);
if (TempResult <> HTCLIENT) then
begin
SetLength(TempTouchInputs, 0);
exit;
end;
end;
TempPoint := Panel1.ScreenToClient(TempPoint);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
// Touch point identifier stays consistent in a touch contact sequence
TempTouchEvent.id := TempTouchInputs[i].dwID;
if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_DOWN) <> 0) then TempTouchEvent.type_ := CEF_TET_PRESSED
else if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_MOVE) <> 0) then TempTouchEvent.type_ := CEF_TET_MOVED
else if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_UP) <> 0) then TempTouchEvent.type_ := CEF_TET_RELEASED;
TempTouchEvent.radius_x := 0;
TempTouchEvent.radius_y := 0;
TempTouchEvent.rotation_angle := 0;
TempTouchEvent.pressure := 0;
TempTouchEvent.modifiers := EVENTFLAG_NONE;
TempTouchEvent.pointer_type := CEF_POINTER_TYPE_TOUCH;
chrmosr.SendTouchEvent(@TempTouchEvent);
inc(i);
end;
CloseTouchInputHandle(TempHTOUCHINPUT);
aHandled := True;
end;
SetLength(TempTouchInputs, 0);
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
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;
@ -781,7 +873,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;
@ -797,7 +889,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;
@ -807,6 +899,30 @@ begin
end;
end;
procedure TForm1.Panel1PointerDown(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
procedure TForm1.Panel1PointerUp(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
procedure TForm1.Panel1PointerUpdate(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
procedure TForm1.Panel1Resize(Sender: TObject);
begin
DoResize;
@ -865,6 +981,146 @@ begin
(cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime);
end;
function TForm1.ArePointerEventsSupported : boolean;
begin
Result := (@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;
PT_PEN = 3;
var
TempID : uint32;
TempType : POINTER_INPUT_TYPE;
begin
Result := False;
TempID := LoWord(aMessage.wParam);
if GetPointerType(TempID, @TempType) then
case TempType of
PT_PEN : Result := HandlePenEvent(TempID, aMessage.Msg);
PT_TOUCH : Result := HandleTouchEvent(TempID, aMessage.Msg);
end;
end;
function TForm1.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
var
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
begin
Result := False;
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 * 3.14159
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);
end;
function TForm1.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean;
var
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
begin
Result := False;
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);
end;
procedure TForm1.Panel1Enter(Sender: TObject);
begin
chrmosr.SendFocusEvent(True);
@ -876,15 +1132,6 @@ begin
chrmosr.SendFocusEvent(False);
end;
procedure TForm1.Panel1Gesture(Sender: TObject;
const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
case EventInfo.GestureID of
sgiLeft : chrmosr.GoBack;
sgiRight : chrmosr.GoForward;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;

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

@ -109,6 +109,10 @@ object Form1: TForm1
OnIMECancelComposition = Panel1IMECancelComposition
OnIMECommitText = Panel1IMECommitText
OnIMESetComposition = Panel1IMESetComposition
OnCustomTouch = Panel1CustomTouch
OnPointerDown = Panel1PointerDown
OnPointerUp = Panel1PointerUp
OnPointerUpdate = Panel1PointerUpdate
OnPaintParentBkg = Panel1PaintParentBkg
Align = alClient
Ctl3D = False

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

@ -88,6 +88,10 @@ type
procedure Panel1IMECancelComposition(Sender: TObject);
procedure Panel1IMECommitText(Sender: TObject; const aText: ustring; const replacement_range: PCefRange; relative_cursor_pos: Integer);
procedure Panel1IMESetComposition(Sender: TObject; const aText: ustring; const underlines: TCefCompositionUnderlineDynArray; const replacement_range, selection_range: TCefRange);
procedure Panel1CustomTouch(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
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 FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -138,6 +142,11 @@ 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;
function HandlePointerEvent(var aMessage : TMessage) : boolean;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
@ -182,6 +191,7 @@ begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
GlobalCEFApp.TouchEvents := STATE_ENABLED;
// If you need transparency leave the GlobalCEFApp.BackgroundColor property
// with the default value or set the alpha channel to 0
@ -729,6 +739,9 @@ begin
// You can skip this if the user doesn't need an "Input Method Editor".
Panel1.CreateIMEHandler;
if not(ArePointerEventsSupported) then
RegisterTouchWindow(Panel1.Handle, 0);
if chrmosr.CreateBrowser(nil, '') then
chrmosr.InitializeDragAndDrop(Panel1)
else
@ -741,12 +754,89 @@ begin
Panel1.SetFocus;
end;
procedure TForm1.Panel1CustomTouch(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
var
TempTouchEvent : TCefTouchEvent;
TempHTOUCHINPUT : HTOUCHINPUT;
TempNumPoints : integer;
i : integer;
TempTouchInputs : array of TTouchInput;
TempPoint : TPoint;
TempAtLeastWin8 : boolean;
TempLParam : LPARAM;
TempResult : LRESULT;
begin
if not(Panel1.Focused) or (GlobalCEFApp = nil) then exit;
TempNumPoints := LOWORD(aMessage.wParam);
// Chromium only supports upto 16 touch points.
if (TempNumPoints < 1) or (TempNumPoints > 16) then exit;
SetLength(TempTouchInputs, TempNumPoints);
TempHTOUCHINPUT := HTOUCHINPUT(aMessage.lParam);
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
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
// ignore touch events in the non-client area.
TempLParam := MakeLParam(TempPoint.x, TempPoint.y);
TempResult := SendMessage(Panel1.Handle, WM_NCHITTEST, 0, TempLParam);
if (TempResult <> HTCLIENT) then
begin
SetLength(TempTouchInputs, 0);
exit;
end;
end;
TempPoint := Panel1.ScreenToClient(TempPoint);
TempTouchEvent.x := DeviceToLogical(TempPoint.x, GlobalCEFApp.DeviceScaleFactor);
TempTouchEvent.y := DeviceToLogical(TempPoint.y, GlobalCEFApp.DeviceScaleFactor);
// Touch point identifier stays consistent in a touch contact sequence
TempTouchEvent.id := TempTouchInputs[i].dwID;
if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_DOWN) <> 0) then TempTouchEvent.type_ := CEF_TET_PRESSED
else if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_MOVE) <> 0) then TempTouchEvent.type_ := CEF_TET_MOVED
else if ((TempTouchInputs[i].dwFlags and TOUCHEVENTF_UP) <> 0) then TempTouchEvent.type_ := CEF_TET_RELEASED;
TempTouchEvent.radius_x := 0;
TempTouchEvent.radius_y := 0;
TempTouchEvent.rotation_angle := 0;
TempTouchEvent.pressure := 0;
TempTouchEvent.modifiers := EVENTFLAG_NONE;
TempTouchEvent.pointer_type := CEF_POINTER_TYPE_TOUCH;
chrmosr.SendTouchEvent(@TempTouchEvent);
inc(i);
end;
CloseTouchInputHandle(TempHTOUCHINPUT);
aHandled := True;
end;
SetLength(TempTouchInputs, 0);
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
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;
@ -796,7 +886,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;
@ -812,7 +902,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;
@ -837,6 +927,154 @@ begin
end;
end;
procedure TForm1.Panel1PointerDown(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
procedure TForm1.Panel1PointerUp(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
procedure TForm1.Panel1PointerUpdate(Sender: TObject; var aMessage: TMessage; var aHandled: Boolean);
begin
aHandled := Panel1.Focused and
(GlobalCEFApp <> nil) and
ArePointerEventsSupported and
HandlePointerEvent(aMessage);
end;
function TForm1.HandlePointerEvent(var aMessage : TMessage) : boolean;
const
PT_TOUCH = 2;
PT_PEN = 3;
var
TempID : uint32;
TempType : POINTER_INPUT_TYPE;
begin
Result := False;
TempID := LoWord(aMessage.wParam);
if GetPointerType(TempID, @TempType) then
case TempType of
PT_PEN : Result := HandlePenEvent(TempID, aMessage.Msg);
PT_TOUCH : Result := HandleTouchEvent(TempID, aMessage.Msg);
end;
end;
function TForm1.HandlePenEvent(const aID : uint32; aMsg : cardinal) : boolean;
var
TempPenInfo : POINTER_PEN_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
begin
Result := False;
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 * 3.14159
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);
end;
function TForm1.HandleTouchEvent(const aID : uint32; aMsg : cardinal) : boolean;
var
TempTouchInfo : POINTER_TOUCH_INFO;
TempTouchEvent : TCefTouchEvent;
TempPoint : TPoint;
begin
Result := False;
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);
end;
procedure TForm1.Panel1Resize(Sender: TObject);
begin
DoResize;
@ -895,6 +1133,22 @@ begin
(cardinal(aCurrentTime - FLastClickTime) > GetDoubleClickTime);
end;
function TForm1.ArePointerEventsSupported : boolean;
begin
Result := (@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);

23
demos/Lazarus/SimpleServer/SimpleServer.lps
View File

@ -8,9 +8,9 @@
<Unit0>
<Filename Value="SimpleServer.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="35"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
<Unit1>
@ -20,24 +20,17 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="196"/>
<CursorPos X="5" Y="249"/>
<EditorIndex Value="-1"/>
<TopLine Value="61"/>
<CursorPos X="73" Y="214"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="uSimpleServer.pas"/>
</Position1>
<Position2>
<Filename Value="uSimpleServer.pas"/>
<Caret Line="290" Column="36" TopLine="272"/>
</Position2>
</JumpHistory>
<General>
<ActiveWindowIndexAtStart Value="-1"/>
</General>
<JumpHistory HistoryIndex="-1"/>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>

62
source/uCEFBufferPanel.pas
View File

@ -63,6 +63,7 @@ uses
type
TOnIMECommitTextEvent = procedure(Sender: TObject; const aText : ustring; const replacement_range : PCefRange; relative_cursor_pos : integer) of object;
TOnIMESetCompositionEvent = procedure(Sender: TObject; const aText : ustring; const underlines : TCefCompositionUnderlineDynArray; const replacement_range, selection_range : TCefRange) of object;
TOnHandledMessageEvent = procedure(Sender: TObject; var aMessage: TMessage; var aHandled : boolean) of object;
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pidWin32 or pidWin64)]{$ENDIF}{$ENDIF}
TBufferPanel = class(TCustomPanel)
@ -77,6 +78,10 @@ type
FOnIMECancelComposition : TNotifyEvent;
FOnIMECommitText : TOnIMECommitTextEvent;
FOnIMESetComposition : TOnIMESetCompositionEvent;
FOnCustomTouch : TOnHandledMessageEvent;
FOnPointerDown : TOnHandledMessageEvent;
FOnPointerUp : TOnHandledMessageEvent;
FOnPointerUpdate : TOnHandledMessageEvent;
{$ENDIF}
procedure CreateSyncObj;
@ -98,6 +103,10 @@ type
procedure CreateParams(var Params: TCreateParams); override;
procedure WndProc(var aMessage: TMessage); override;
procedure WMEraseBkgnd(var aMessage : TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMTouch(var aMessage: TMessage); message WM_TOUCH;
procedure WMPointerDown(var aMessage: TMessage); message WM_POINTERDOWN;
procedure WMPointerUpdate(var aMessage: TMessage); message WM_POINTERUPDATE;
procedure WMPointerUp(var aMessage: TMessage); message WM_POINTERUP;
procedure WMIMEStartComp(var aMessage: TMessage);
procedure WMIMEEndComp(var aMessage: TMessage);
procedure WMIMESetContext(var aMessage: TMessage);
@ -132,6 +141,11 @@ type
property OnIMECancelComposition : TNotifyEvent read FOnIMECancelComposition write FOnIMECancelComposition;
property OnIMECommitText : TOnIMECommitTextEvent read FOnIMECommitText write FOnIMECommitText;
property OnIMESetComposition : TOnIMESetCompositionEvent read FOnIMESetComposition write FOnIMESetComposition;
property OnCustomTouch : TOnHandledMessageEvent read FOnCustomTouch write FOnCustomTouch;
property OnPointerDown : TOnHandledMessageEvent read FOnPointerDown write FOnPointerDown;
property OnPointerUp : TOnHandledMessageEvent read FOnPointerUp write FOnPointerUp;
property OnPointerUpdate : TOnHandledMessageEvent read FOnPointerUpdate write FOnPointerUpdate;
{$ENDIF}
property OnPaintParentBkg : TNotifyEvent read FOnPaintParentBkg write FOnPaintParentBkg;
@ -249,6 +263,10 @@ begin
FOnIMECancelComposition := nil;
FOnIMECommitText := nil;
FOnIMESetComposition := nil;
FOnCustomTouch := nil;
FOnPointerDown := nil;
FOnPointerUp := nil;
FOnPointerUpdate := nil;
{$ENDIF}
end;
@ -467,6 +485,50 @@ begin
aMessage.Result := 1;
end;
procedure TBufferPanel.WMTouch(var aMessage: TMessage);
var
TempHandled : boolean;
begin
TempHandled := False;
{$IFDEF MSWINDOWS}
if assigned(FOnCustomTouch) then FOnCustomTouch(self, aMessage, TempHandled);
{$ENDIF}
if not(TempHandled) then inherited;
end;
procedure TBufferPanel.WMPointerDown(var aMessage: TMessage);
var
TempHandled : boolean;
begin
TempHandled := False;
{$IFDEF MSWINDOWS}
if assigned(FOnPointerDown) then FOnPointerDown(self, aMessage, TempHandled);
{$ENDIF}
if not(TempHandled) then inherited;
end;
procedure TBufferPanel.WMPointerUpdate(var aMessage: TMessage);
var
TempHandled : boolean;
begin
TempHandled := False;
{$IFDEF MSWINDOWS}
if assigned(FOnPointerUpdate) then FOnPointerUpdate(self, aMessage, TempHandled);
{$ENDIF}
if not(TempHandled) then inherited;
end;
procedure TBufferPanel.WMPointerUp(var aMessage: TMessage);
var
TempHandled : boolean;
begin
TempHandled := False;
{$IFDEF MSWINDOWS}
if assigned(FOnPointerUp) then FOnPointerUp(self, aMessage, TempHandled);
{$ENDIF}
if not(TempHandled) then inherited;
end;
procedure TBufferPanel.WMIMEStartComp(var aMessage: TMessage);
begin
if (FIMEHandler <> nil) then

2
source/uCEFFMXWindowParent.pas
View File

@ -71,6 +71,8 @@ type
property Visible;
property Height;
property Width;
property Touch;
property OnGesture;
end;
implementation

21
source/uCEFMiscFunctions.pas
View File

@ -260,10 +260,13 @@ procedure DragOperationToDropEffect(const aDragOperations : TCefDragOperations;
function GetWindowsMajorMinorVersion(var wMajorVersion, wMinorVersion : DWORD) : boolean;
function GetDefaultCEFUserAgent : string;
function TouchPointToPoint(aHandle : HWND; const TouchPoint: TTouchInput): TPoint;
{$ENDIF}
function DeviceToLogical(aValue : integer; const aDeviceScaleFactor : double) : integer; overload;
function DeviceToLogical(aValue : single; const aDeviceScaleFactor : double) : single; overload;
procedure DeviceToLogical(var aEvent : TCEFMouseEvent; const aDeviceScaleFactor : double); overload;
procedure DeviceToLogical(var aEvent : TCefTouchEvent; const aDeviceScaleFactor : double); overload;
procedure DeviceToLogical(var aPoint : TPoint; const aDeviceScaleFactor : double); overload;
function LogicalToDevice(aValue : integer; const aDeviceScaleFactor : double) : integer; overload;
procedure LogicalToDevice(var aRect : TCEFRect; const aDeviceScaleFactor : double); overload;
@ -283,6 +286,7 @@ function CefGetDataURI(aData : pointer; aSize : integer; const aMimeType : ustri
implementation
uses
System.Types,
uCEFApplicationCore, uCEFSchemeHandlerFactory, uCEFValue,
uCEFBinaryValue, uCEFStringList;
@ -2081,6 +2085,12 @@ begin
'AppleWebKit/537.36 (KHTML, like Gecko) ' +
'Chrome/' + TempChromiumVersion + ' Safari/537.36';
end;
function TouchPointToPoint(aHandle : HWND; const TouchPoint: TTouchInput): TPoint;
begin
Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
PhysicalToLogicalPoint(aHandle, Result);
end;
{$ENDIF}
function DeviceToLogical(aValue : integer; const aDeviceScaleFactor : double) : integer;
@ -2088,12 +2098,23 @@ begin
Result := floor(aValue / aDeviceScaleFactor);
end;
function DeviceToLogical(aValue : single; const aDeviceScaleFactor : double) : single;
begin
Result := aValue / aDeviceScaleFactor;
end;
procedure DeviceToLogical(var aEvent : TCEFMouseEvent; const aDeviceScaleFactor : double);
begin
aEvent.x := DeviceToLogical(aEvent.x, aDeviceScaleFactor);
aEvent.y := DeviceToLogical(aEvent.y, aDeviceScaleFactor);
end;
procedure DeviceToLogical(var aEvent : TCefTouchEvent; const aDeviceScaleFactor : double);
begin
aEvent.x := DeviceToLogical(aEvent.x, aDeviceScaleFactor);
aEvent.y := DeviceToLogical(aEvent.y, aDeviceScaleFactor);
end;
procedure DeviceToLogical(var aPoint : TPoint; const aDeviceScaleFactor : double);
begin
aPoint.x := DeviceToLogical(aPoint.x, aDeviceScaleFactor);

2
update_CEF4Delphi.json
View File

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