mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-04-17 06:57:13 +02:00
Expose additional event properties
This commit is contained in:
martin
parent
05d3f02c8e
commit
c45c130b33
@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Package Version="5">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="CEF4Delphi_Lazarus"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
@ -850,19 +850,23 @@
|
||||
<UnitName Value="uCEFLazarusOsrBrowserWindow"/>
|
||||
</Item202>
|
||||
</Files>
|
||||
<RequiredPkgs Count="4">
|
||||
<CompatibilityMode Value="True"/>
|
||||
<RequiredPkgs Count="5">
|
||||
<Item1>
|
||||
<PackageName Value="dcpcrypt"/>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="dcpcrypt"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCLBase"/>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="FCL"/>
|
||||
<PackageName Value="LCLBase"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item5>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
|
||||
@ -44,21 +44,33 @@ interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LResources,
|
||||
LResources, PropEdits,
|
||||
{$ENDIF}
|
||||
uCEFApplication, uCEFChromiumWindow, uCEFTypes, uCEFInterfaces, uCEFChromium,
|
||||
uCEFLinkedWinControlBase, uCEFLazApplication, uCEFBufferPanel,
|
||||
uCEFLazarusBrowserWindow, uCEFBitmapBitBuffer, uCEFMiscFunctions,
|
||||
uCEFConstants, Forms, ExtCtrls, LCLType, Graphics, Controls, syncobjs,
|
||||
LazLogger, Classes, sysutils, math;
|
||||
uCEFConstants, uCEFChromiumEvents, Forms, ExtCtrls, LCLType, Graphics,
|
||||
Controls, syncobjs, LazLogger, Classes, sysutils, math;
|
||||
|
||||
type
|
||||
|
||||
TBrowserMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer;
|
||||
var AHandled: Boolean) of Object;
|
||||
TBrowserMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: Integer;
|
||||
var AHandled: Boolean) of Object;
|
||||
TBrowserMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
|
||||
WheelDelta: Integer; MousePos: TPoint;
|
||||
var AHandled: Boolean) of Object;
|
||||
TBrowserKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState; var AHandled: Boolean) of Object;
|
||||
//TBrowserKeyPressEvent = procedure(Sender: TObject; var Key: char; var AHandled: Boolean) of Object;
|
||||
TBrowserUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char; var AHandled: Boolean) of Object;
|
||||
|
||||
|
||||
TLazOsrChromium = class(TLazChromium)
|
||||
end;
|
||||
|
||||
{ TLazarusOsrBrowserWindow }
|
||||
|
||||
TLazarusOsrBrowserWindow = class(TBufferPanel)
|
||||
@ -114,17 +126,22 @@ type
|
||||
AHeight: Integer);
|
||||
|
||||
private
|
||||
FChromium : TLazChromium;
|
||||
FChromium : TLazOsrChromium;
|
||||
|
||||
FOnBrowserClosed : TNotifyEvent;
|
||||
FOnBrowserCreated : TNotifyEvent;
|
||||
FOnKeyDown: TBrowserKeyEvent;
|
||||
FOnKeyUp: TBrowserKeyEvent;
|
||||
FOnMouseDown: TBrowserMouseEvent;
|
||||
FOnMouseMove: TBrowserMouseMoveEvent;
|
||||
FOnMouseUp: TBrowserMouseEvent;
|
||||
FOnMouseWheel: TBrowserMouseWheelEvent;
|
||||
FOnUtf8KeyPress: TBrowserUTF8KeyPressEvent;
|
||||
|
||||
procedure DoCreateBrowserAfterContext(Sender: TObject);
|
||||
|
||||
protected
|
||||
function GetChromium: TLazChromium;
|
||||
function GetChromium: TLazOsrChromium;
|
||||
function getModifiers(Shift: TShiftState): TCefEventFlags;
|
||||
function getKeyModifiers(Shift: TShiftState): TCefEventFlags;
|
||||
function GetButton(Button: TMouseButton): TCefMouseButtonType;
|
||||
@ -166,13 +183,18 @@ type
|
||||
procedure LoadURL(aURL: ustring);
|
||||
//
|
||||
published
|
||||
property Chromium : TLazChromium read GetChromium;
|
||||
property Chromium : TLazOsrChromium read GetChromium;
|
||||
|
||||
property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated;
|
||||
property OnBrowserClosed : TNotifyEvent read FOnBrowserClosed write FOnBrowserClosed;
|
||||
|
||||
property OnMouseDown: TBrowserMouseEvent read FOnMouseDown write FOnMouseDown;
|
||||
property OnMouseUp: TBrowserMouseEvent read FOnMouseUp write FOnMouseUp;
|
||||
property OnMouseMove: TBrowserMouseMoveEvent read FOnMouseMove write FOnMouseMove;
|
||||
property OnMouseWheel: TBrowserMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
|
||||
property OnKeyDown: TBrowserKeyEvent read FOnKeyDown write FOnKeyDown;
|
||||
property OnKeyUp: TBrowserKeyEvent read FOnKeyUp write FOnKeyUp;
|
||||
property OnUtf8KeyPress: TBrowserUTF8KeyPressEvent read FOnUtf8KeyPress write FOnUtf8KeyPress;
|
||||
end;
|
||||
|
||||
{$IFDEF FPC}
|
||||
@ -498,7 +520,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazarusOsrBrowserWindow.GetChromium: TLazChromium;
|
||||
function TLazarusOsrBrowserWindow.GetChromium: TLazOsrChromium;
|
||||
begin
|
||||
Result := FChromium;
|
||||
end;
|
||||
@ -649,8 +671,14 @@ end;
|
||||
procedure TLazarusOsrBrowserWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
TempEvent : TCefMouseEvent;
|
||||
IsHandled: Boolean;
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
IsHandled := False;
|
||||
if FOnMouseMove <> nil then
|
||||
FOnMouseMove(Self, Shift, X, Y, IsHandled);
|
||||
if IsHandled then
|
||||
exit;
|
||||
|
||||
TempEvent.x := x;
|
||||
TempEvent.y := y;
|
||||
@ -699,8 +727,14 @@ function TLazarusOsrBrowserWindow.DoMouseWheel(Shift: TShiftState;
|
||||
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
||||
var
|
||||
TempEvent : TCefMouseEvent;
|
||||
IsHandled: Boolean;
|
||||
begin
|
||||
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
||||
IsHandled := False;
|
||||
if FOnMouseWheel <> nil then
|
||||
FOnMouseWheel(Self, Shift, WheelDelta, MousePos, IsHandled);
|
||||
if IsHandled then
|
||||
exit;
|
||||
|
||||
TempEvent.x := MousePos.x;
|
||||
TempEvent.y := MousePos.y;
|
||||
@ -717,7 +751,16 @@ end;
|
||||
procedure TLazarusOsrBrowserWindow.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
TempKeyEvent : TCefKeyEvent;
|
||||
IsHandled: Boolean;
|
||||
begin
|
||||
IsHandled := False;
|
||||
if FOnKeyDown <> nil then
|
||||
FOnKeyDown(Self, Key, Shift, IsHandled);
|
||||
if IsHandled then begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
exit;
|
||||
end;
|
||||
|
||||
FLastKeyDown := Key;
|
||||
if (Key <> 0) and (Chromium <> nil) then
|
||||
begin
|
||||
@ -742,7 +785,16 @@ procedure TLazarusOsrBrowserWindow.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
||||
var
|
||||
TempKeyEvent : TCefKeyEvent;
|
||||
TempString : UnicodeString;
|
||||
IsHandled: Boolean;
|
||||
begin
|
||||
IsHandled := False;
|
||||
if FOnUtf8KeyPress <> nil then
|
||||
FOnUtf8KeyPress(Self, UTF8Key, IsHandled);
|
||||
if IsHandled then begin
|
||||
inherited UTF8KeyPress(UTF8Key);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Focused then
|
||||
begin
|
||||
TempString := UTF8Decode(UTF8Key);
|
||||
@ -773,7 +825,16 @@ end;
|
||||
procedure TLazarusOsrBrowserWindow.KeyUp(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
TempKeyEvent : TCefKeyEvent;
|
||||
IsHandled: Boolean;
|
||||
begin
|
||||
IsHandled := False;
|
||||
if FOnKeyUp <> nil then
|
||||
FOnKeyUp(Self, Key, Shift, IsHandled);
|
||||
if IsHandled then begin
|
||||
inherited KeyUp(Key, Shift);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key <> 0) and (Chromium <> nil) then
|
||||
begin
|
||||
TempKeyEvent.kind := KEYEVENT_KEYUP;
|
||||
@ -843,9 +904,9 @@ begin
|
||||
FSelectedRange.from := 0;
|
||||
FSelectedRange.to_ := 0;
|
||||
|
||||
FChromium := TLazChromium.Create(Self);
|
||||
FChromium.OnBrowserClosed := {$IFDEF FPC}@{$ENDIF}DoOnClosed;
|
||||
FChromium.OnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnCreated;
|
||||
FChromium := TLazOsrChromium.Create(Self);
|
||||
FChromium.InternalOnBrowserClosed := {$IFDEF FPC}@{$ENDIF}DoOnClosed;
|
||||
FChromium.InternalOnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnCreated;
|
||||
|
||||
FChromium.OnPaint := {$IFDEF FPC}@{$ENDIF}DoChromiumPaint;
|
||||
FChromium.OnGetViewRect := {$IFDEF FPC}@{$ENDIF}DoGetChromiumViewRect;
|
||||
@ -910,6 +971,17 @@ procedure Register;
|
||||
begin
|
||||
// {$I res/tlazarusosrbrowserwindow.lrs}
|
||||
RegisterComponents('Chromium', [TLazarusOsrBrowserWindow]);
|
||||
RegisterPropertyEditor(TypeInfo(TOnClose), TLazOsrChromium,'OnClose',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnPaint), TLazOsrChromium,'OnPaint',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnGetViewRect), TLazOsrChromium,'OnGetViewRect',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnCursorChange), TLazOsrChromium,'OnCursorChange',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnGetScreenPoint), TLazOsrChromium,'OnGetScreenPoint',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnGetScreenInfo), TLazOsrChromium,'OnGetScreenInfo',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnPopupShow), TLazOsrChromium,'OnPopupShow',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnPopupSize), TLazOsrChromium,'OnPopupSize',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnTooltip), TLazOsrChromium,'OnTooltip',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnBeforePopup), TLazOsrChromium,'OnBeforePopup',THiddenPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnIMECompositionRangeChanged), TLazOsrChromium,'OnIMECompositionRangeChanged',THiddenPropertyEditor);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
@ -44,11 +44,11 @@ interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LResources,
|
||||
LResources, PropEdits,
|
||||
{$ENDIF}
|
||||
uCEFApplication, uCEFChromiumWindow, uCEFTypes, uCEFInterfaces, uCEFChromium,
|
||||
uCEFLinkedWinControlBase, uCEFLazApplication, uCEFBrowserViewComponent, Forms,
|
||||
ExtCtrls, Controls, Classes, sysutils;
|
||||
uCEFLinkedWinControlBase, uCEFLazApplication, uCEFBrowserViewComponent,
|
||||
uCEFChromiumEvents, Forms, ExtCtrls, Controls, Classes, sysutils;
|
||||
|
||||
type
|
||||
|
||||
@ -63,18 +63,22 @@ type
|
||||
private type
|
||||
TLazChromiumState = (csNoBrowser, csCreatingBrowser, csHasBrowser, csClosingBrowser, csCloseAfterCreate);
|
||||
private
|
||||
FInternalOnGotFocus: TOnGotFocus;
|
||||
FState : TLazChromiumState;
|
||||
FOnBrowserClosed : TNotifyEvent;
|
||||
FOnBrowserCreated : TNotifyEvent;
|
||||
FInternalOnBrowserClosed : TNotifyEvent;
|
||||
FInternalOnBrowserCreated : TNotifyEvent;
|
||||
|
||||
FLoadUrl, FFrameName : ustring;
|
||||
function GetIsClosing: Boolean;
|
||||
procedure SetInternalOnClose(AValue: TOnClose);
|
||||
|
||||
protected
|
||||
function GetHasBrowser : boolean; reintroduce;
|
||||
|
||||
procedure doOnBeforeClose(const ABrowser: ICefBrowser); override;
|
||||
procedure doOnAfterCreated(const ABrowser: ICefBrowser); override;
|
||||
procedure doOnGotFocus(const Abrowser: ICefBrowser); override;
|
||||
function MustCreateFocusHandler: boolean; override;
|
||||
|
||||
procedure DoCreated(Data: PtrInt);
|
||||
procedure DoOnClosed(Data: PtrInt);
|
||||
@ -108,8 +112,9 @@ type
|
||||
- OnBrowserCreated: the parent event may be called when procedure Initialized is still false.
|
||||
- OnBrowserCreated: may not be called, if the CloseBrowser has already been called
|
||||
*)
|
||||
property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated;
|
||||
property OnBrowserClosed : TNotifyEvent read FOnBrowserClosed write FOnBrowserClosed;
|
||||
property InternalOnBrowserCreated : TNotifyEvent read FInternalOnBrowserCreated write FInternalOnBrowserCreated;
|
||||
property InternalOnBrowserClosed : TNotifyEvent read FInternalOnBrowserClosed write FInternalOnBrowserClosed;
|
||||
property InternalOnGotFocus : TOnGotFocus read FInternalOnGotFocus write FInternalOnGotFocus;
|
||||
end;
|
||||
|
||||
TLazarusBrowserWindow = class;
|
||||
@ -148,6 +153,7 @@ type
|
||||
*)
|
||||
procedure WaitForBrowserClosed;
|
||||
|
||||
published
|
||||
property Chromium: TLazChromium read FChromium;
|
||||
end;
|
||||
|
||||
@ -167,6 +173,7 @@ type
|
||||
|
||||
procedure DoCreateBrowser(Sender: TObject);
|
||||
procedure DoCreateBrowserAfterContext(Sender: TObject);
|
||||
function GetLazChromium: TLazChromium;
|
||||
protected
|
||||
function GetChromium: TChromium; override;
|
||||
procedure DestroyHandle; override;
|
||||
@ -188,7 +195,7 @@ type
|
||||
procedure LoadURL(aURL: ustring);
|
||||
|
||||
published
|
||||
property Chromium; // : TChromium read GetChromium;
|
||||
property Chromium: TLazChromium read GetLazChromium;
|
||||
|
||||
property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated;
|
||||
(* OnBrowserClosed will not be called, if the TLazarusBrowserWindow is
|
||||
@ -210,6 +217,11 @@ begin
|
||||
Result := FState in [csCloseAfterCreate, csClosingBrowser];
|
||||
end;
|
||||
|
||||
procedure TLazChromium.SetInternalOnClose(AValue: TOnClose);
|
||||
begin
|
||||
inherited OnClose := AValue;
|
||||
end;
|
||||
|
||||
function TLazChromium.GetHasBrowser: boolean;
|
||||
begin
|
||||
Result := (FState <> csNoBrowser) or (inherited GetHasBrowser);
|
||||
@ -233,6 +245,19 @@ begin
|
||||
Application.QueueAsyncCall(@DoCreated, 0);
|
||||
end;
|
||||
|
||||
procedure TLazChromium.doOnGotFocus(const Abrowser: ICefBrowser);
|
||||
begin
|
||||
inherited doOnGotFocus(Abrowser);
|
||||
if Assigned(FInternalOnGotFocus) then
|
||||
FInternalOnGotFocus(Self, Abrowser);
|
||||
end;
|
||||
|
||||
function TLazChromium.MustCreateFocusHandler: boolean;
|
||||
begin
|
||||
Result := assigned(FInternalOnGotFocus) or
|
||||
inherited MustCreateFocusHandler;
|
||||
end;
|
||||
|
||||
procedure TLazChromium.DoCreated(Data: PtrInt);
|
||||
var
|
||||
u, f: ustring;
|
||||
@ -247,8 +272,8 @@ begin
|
||||
LoadURL(u, f);
|
||||
end;
|
||||
|
||||
if (FOnBrowserCreated <> nil) then
|
||||
FOnBrowserCreated(Self);
|
||||
if (FInternalOnBrowserCreated <> nil) then
|
||||
FInternalOnBrowserCreated(Self);
|
||||
end;
|
||||
csCloseAfterCreate: begin
|
||||
FState := csHasBrowser;
|
||||
@ -259,8 +284,8 @@ end;
|
||||
|
||||
procedure TLazChromium.DoOnClosed(Data: PtrInt);
|
||||
begin
|
||||
if (FOnBrowserClosed <> nil) then
|
||||
FOnBrowserClosed(Self);
|
||||
if (FInternalOnBrowserClosed <> nil) then
|
||||
FInternalOnBrowserClosed(Self);
|
||||
end;
|
||||
|
||||
constructor TLazChromium.Create(AOwner: TComponent);
|
||||
@ -400,15 +425,15 @@ begin
|
||||
FBrowserWindow := AOwner;
|
||||
FWrapperState := wsNone;
|
||||
|
||||
FChromium := TLazChromium.Create(nil);
|
||||
if not(csDesigning in AOwner.ComponentState) then
|
||||
begin
|
||||
FChromium := TLazChromium.Create(nil);
|
||||
FChromium.OnClose := {$IFDEF FPC}@{$ENDIF}BrowserThread_OnClose;
|
||||
FChromium.OnBrowserClosed := {$IFDEF FPC}@{$ENDIF}DoOnBeforeClose;
|
||||
FChromium.OnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnAfterCreated;
|
||||
FChromium.InternalOnBrowserClosed := {$IFDEF FPC}@{$ENDIF}DoOnBeforeClose;
|
||||
FChromium.InternalOnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnAfterCreated;
|
||||
{$IFDEF LINUX}
|
||||
// This is a workaround for the CEF issue #2026. Read below for more info.
|
||||
FChromium.OnGotFocus := {$IFDEF FPC}@{$ENDIF}BrowserThread_OnGotFocus;
|
||||
FChromium.InternalOnGotFocus := {$IFDEF FPC}@{$ENDIF}BrowserThread_OnGotFocus;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
@ -518,6 +543,11 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TLazarusBrowserWindow.GetLazChromium: TLazChromium;
|
||||
begin
|
||||
Result := FChromiumWrapper.Chromium;
|
||||
end;
|
||||
|
||||
function TLazarusBrowserWindow.GetChromium: TChromium;
|
||||
begin
|
||||
Result := FChromiumWrapper.FChromium;
|
||||
@ -643,6 +673,8 @@ procedure Register;
|
||||
begin
|
||||
{$I res/tlazarusbrowserwindow.lrs}
|
||||
RegisterComponents('Chromium', [TLazarusBrowserWindow]);
|
||||
RegisterPropertyEditor(ClassTypeInfo(TLazChromium), nil,'',TClassPropertyEditor);
|
||||
RegisterPropertyEditor(TypeInfo(TOnClose), TLazChromium, 'OnClose', THiddenPropertyEditor);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user