Expose additional event properties

packages/cef4delphi_lazarus.lpk

@@ -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)"/>

source/uCEFLazarusOsrBrowserWindow.pas

@@ -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,
+  uCEFConstants, uCEFChromiumEvents, Forms, ExtCtrls, LCLType, Graphics,
-  LazLogger, Classes, sysutils, math;
+  Controls, syncobjs, LazLogger, Classes, sysutils, math;
 
 type
 
   TBrowserMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
-                          Shift: TShiftState; X, Y: Integer;
+    Shift: TShiftState; X, Y: Integer;
-                          var AHandled: Boolean) of Object;
+    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    OnMouseDown:    TBrowserMouseEvent      read FOnMouseDown write FOnMouseDown;
-      property    OnMouseUp: TBrowserMouseEvent read FOnMouseUp write FOnMouseUp;
+      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 := TLazOsrChromium.Create(Self);
-  FChromium.OnBrowserClosed              := {$IFDEF FPC}@{$ENDIF}DoOnClosed;
+  FChromium.InternalOnBrowserClosed              := {$IFDEF FPC}@{$ENDIF}DoOnClosed;
-  FChromium.OnBrowserCreated             := {$IFDEF FPC}@{$ENDIF}DoOnCreated;
+  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}
 

source/uceflazarusbrowserwindow.pas

@@ -44,11 +44,11 @@ interface
 
 uses
   {$IFDEF FPC}
-  LResources,
+  LResources, PropEdits,
   {$ENDIF}
   uCEFApplication, uCEFChromiumWindow, uCEFTypes, uCEFInterfaces, uCEFChromium,
-  uCEFLinkedWinControlBase, uCEFLazApplication, uCEFBrowserViewComponent, Forms,
+  uCEFLinkedWinControlBase, uCEFLazApplication, uCEFBrowserViewComponent,
-  ExtCtrls, Controls, Classes, sysutils;
+  uCEFChromiumEvents, Forms, ExtCtrls, Controls, Classes, sysutils;
 
 type
 
@@ -63,18 +63,22 @@ type
     private type
       TLazChromiumState   = (csNoBrowser, csCreatingBrowser, csHasBrowser, csClosingBrowser, csCloseAfterCreate);
     private
-      FState               : TLazChromiumState;
+      FInternalOnGotFocus: TOnGotFocus;
-      FOnBrowserClosed     : TNotifyEvent;
+      FState                    : TLazChromiumState;
-      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    InternalOnBrowserCreated : TNotifyEvent read FInternalOnBrowserCreated write FInternalOnBrowserCreated;
-      property    OnBrowserClosed  : TNotifyEvent read FOnBrowserClosed write FOnBrowserClosed;
+      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
+        if (FInternalOnBrowserCreated <> nil) then
-          FOnBrowserCreated(Self);
+          FInternalOnBrowserCreated(Self);
       end;
     csCloseAfterCreate: begin
         FState := csHasBrowser;
@@ -259,8 +284,8 @@ end;
 
 procedure TLazChromium.DoOnClosed(Data: PtrInt);
 begin
-  if (FOnBrowserClosed <> nil) then
+  if (FInternalOnBrowserClosed <> nil) then
-    FOnBrowserClosed(Self);
+    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.OnClose          := {$IFDEF FPC}@{$ENDIF}BrowserThread_OnClose;
+      FChromium.InternalOnBrowserClosed  := {$IFDEF FPC}@{$ENDIF}DoOnBeforeClose;
-      FChromium.OnBrowserClosed  := {$IFDEF FPC}@{$ENDIF}DoOnBeforeClose;
+      FChromium.InternalOnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnAfterCreated;
-      FChromium.OnBrowserCreated := {$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}