* OnClick event

demo/DivAndSpan/FresnelDivAndSpan1.lpi

@@ -41,6 +41,7 @@
         <Filename Value="mainunit.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="MainUnit"/>
       </Unit>

demo/DivAndSpan/mainunit.pas

@@ -5,8 +5,8 @@ unit MainUnit;
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, FresnelControls,
-  FresnelDOM, FresnelLayouter, FresnelLCLControls;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Fresnel.Controls,
+  Fresnel.DOM, fresnel.events, fcl.events,Fresnel.Layouter, Fresnel.LCLControls;
 
 type
 
@@ -15,6 +15,7 @@ type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
   private
+    procedure DoClick(Event: TAbstractEvent);
 
   public
 
@@ -39,6 +40,7 @@ var
   Fresnel1: TFresnelLCLControl;
   Span1: TSpan;
 begin
+  TFresnelEventDispatcher.RegisterFresnelEvents;
   Fresnel1:=TFresnelLCLControl.Create(Self);
   with Fresnel1 do
   begin
@@ -55,6 +57,7 @@ begin
     Name:='Body1';
     Parent:=ViewPort;
     Style:='border: 2px; border-color: blue;';
+    OnClick:=@DoClick;
   end;
 
   Div1:=TDiv.Create(Self);
@@ -62,6 +65,7 @@ begin
     Name:='Div1';
     Parent:=Body1;
     Style:='background-color: blue; border-color: black; height:50px;';
+    OnClick:=@DoClick;
   end;
 
   Span1:=TSpan.Create(Self);
@@ -69,6 +73,7 @@ begin
     Name:='Span1';
     Parent:=Body1;
     Style:='width: 50px; height:70px; background-color: red; border: 3px; border-color: black; margin: 3px;';
+    OnClick:=@DoClick;
   end;
 
   Label1:=TLabel.Create(Self);
@@ -78,6 +83,7 @@ begin
     Caption:='Label1Caption';
     Parent:=Body1;
     Style:='background-color: green; ';
+    OnClick:=@DoClick;
   end;
 
   Div2:=TDiv.Create(Self);
@@ -85,8 +91,14 @@ begin
     Name:='Div2';
     Parent:=Body1;
     Style:='border-color: black; height:50px; position: absolute; left: 30px; top: 100px; width: 50px; height: 60px;';
+    OnClick:=@DoClick;
   end;
 end;
 
+procedure TForm1.DoClick(Event: TAbstractEvent);
+begin
+  ShowMessage('You clicked '+(Event.sender as TComponent).Name);
+end;
+
 end.
 

src/basevents.pas → src/fcl.events.pas

@@ -1,4 +1,4 @@
-unit basevents;
+unit fcl.events;
 
 {$mode ObjFPC}
 {$H+}
@@ -154,6 +154,43 @@ Type
   end;
 
 
+  { TObjectEventHandlerItem }
+
+  TObjectEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventHandler;
+  Protected
+    function MatchHandler(aHandler : TEventHandler; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  Public
+    Property EventHandler : TEventHandler Read FEventHandler Write FEventHandler;
+  end;
+
+  { TCallBackEventHandlerItem }
+
+  TCallBackEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventCallback;
+  Protected
+    function MatchHandler(aHandler : TEventCallBack; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  Public
+    Property EventHandler : TEventCallback Read FEventHandler;
+  end;
+
+  { TReferenceEventHandlerItem }
+
+  TReferenceEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventHandlerRef;
+  Protected
+    function MatchHandler(aHandler :TEventHandlerRef; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  Public
+     Property EventHandler : TEventHandlerRef Read FEventHandler;
+  end;
+
+
   { TEventDispatcher }
 
   TEventSetupHandler = Procedure(Event : TAbstractEvent) of object;
@@ -435,37 +472,6 @@ begin
 end;
 
 
-Type
-
-  { TObjectEventHandlerItem }
-
-  TObjectEventHandlerItem = Class(TEventHandlerItem)
-  Private
-    FEventHandler : TEventHandler;
-  Protected
-    function MatchHandler(aHandler : TEventHandler; aEventID : TEventID) : Boolean; override;
-    Procedure CallHandler(aEvent : TAbstractEvent); override;
-  end;
-
-  { TCallBackEventHandlerItem }
-
-  TCallBackEventHandlerItem = Class(TEventHandlerItem)
-  Private
-    FEventHandler : TEventCallback;
-  Protected
-    function MatchHandler(aHandler : TEventCallBack; aEventID : TEventID) : Boolean; override;
-    Procedure CallHandler(aEvent : TAbstractEvent); override;
-  end;
-
-  { TReferenceEventHandlerItem }
-
-  TReferenceEventHandlerItem = Class(TEventHandlerItem)
-  Private
-    FEventHandler : TEventHandlerRef;
-  Protected
-    function MatchHandler(aHandler :TEventHandlerRef; aEventID : TEventID) : Boolean; override;
-    Procedure CallHandler(aEvent : TAbstractEvent); override;
-  end;
 
 { TReferenceEventHandlerItem }
 

src/fresnel.dom.pas

@@ -27,7 +27,7 @@ interface
 
 uses
   Classes, SysUtils, Math, FPImage, sortbase,
-  fpCSSResolver, fpCSSTree, fpCSSParser,
+  fpCSSResolver, fpCSSTree, fpCSSParser, fcl.events, fresnel.events,
   LazLoggerBase;
 
 type
@@ -305,6 +305,11 @@ type
     FFontDescValid: boolean;
     FRendered: boolean;
     FRenderedBorderBox: TFresnelRect;
+    // Todo: change to dictionary to reduce mem footprint
+    FStandardEvents : Array[0..MaxFresnelEvents] of TEventHandlerItem;
+    FEventDispatcher : TFresnelEventDispatcher;
+    function GetEventHandler(AIndex: Integer): TFresnelEventHandler;
+    procedure SetEventHandler(AIndex: Integer; AValue: TFresnelEventHandler);
  class var
     // Stuff for registering CSS numerical IDs
     FCSSNumericalIDs: array[TCSSNumericalIDKind] of TCSSNumericalIDs;
@@ -461,6 +466,9 @@ type
     property CSSRenderedAttribute[Attr: TFresnelCSSAttribute]: string read GetCSSRenderedAttribute write SetCSSRenderedAttribute;
     // font
     property Font: IFresnelFont read GetFont write FFont;
+    // Events
+    Property EventDispatcher : TFresnelEventDispatcher Read FEventDispatcher;
+    Property OnClick : TFresnelEventHandler Index evtClick Read GetEventHandler Write SetEventHandler;
   published
     property CSSClasses: TStrings read FCSSClasses write SetCSSClasses;
     property Style: string read FStyle write SetStyle;
@@ -1194,6 +1202,21 @@ begin
   FCSSRendered[Attr]:=AValue;
 end;
 
+function TFresnelElement.GetEventHandler(AIndex: Integer): TFresnelEventHandler;
+begin
+  Result:=nil;
+  If Assigned(FStandardEvents[aIndex]) then
+    Result:=TObjectEventHandlerItem(FStandardEvents[aIndex]).EventHandler;
+end;
+
+procedure TFresnelElement.SetEventHandler(AIndex: Integer; AValue: TFresnelEventHandler);
+begin
+  If Assigned(FStandardEvents[aIndex]) then
+    TObjectEventHandlerItem(FStandardEvents[aIndex]).EventHandler:=aValue
+  else
+    FStandardEvents[aIndex]:=FEventDispatcher.RegisterHandler(aValue,aIndex);
+end;
+
 procedure TFresnelElement.SetCSSClasses(const AValue: TStrings);
 begin
   if FCSSClasses=AValue then Exit;
@@ -2700,6 +2723,7 @@ begin
   FCSSClasses:=TStringList.Create;
   FCSSClasses.Delimiter:=' ';
   FCSSClasses.FPOAttachObserver(Self);
+  FEventDispatcher:=TFresnelEventDispatcher.Create(Self);
 end;
 
 destructor TFresnelElement.Destroy;
@@ -2709,6 +2733,7 @@ begin
   FreeAndNil(FLayoutNode);
   FreeAndNil(FChildren);
   FreeAndNil(FCSSClasses);
+  FreeAndNil(FEventDispatcher);
   inherited Destroy;
 end;
 

src/fresnel.events.pas

@@ -5,7 +5,7 @@ unit fresnel.events;
 interface
 
 uses
-  Classes, SysUtils, basevents;
+  Classes, SysUtils, fcl.events;
 
 {$ScopedEnums ON}
 
@@ -33,16 +33,16 @@ Const
   evtMouseEnter = 20;
   evtMouseLeave = 21;
   evtMouseWheel = 22;
-  evtFocusIn = 24;
-  evtFocusOut = 25;
-  evtFocus = 26;
-  evtBlur = 27;
+  evtFocusIn = 23;
+  evtFocusOut = 24;
+  evtFocus = 25;
+  evtBlur = 26;
 
 
 
 
 
-  MaxFresnelEvents = evtChange;
+  MaxFresnelEvents = evtBlur;
 
 
 Type
@@ -61,6 +61,11 @@ Type
   end;
   TFresnelEventClass = Class of TFresnelEvent;
 
+  TFresnelEventHandler = TEventHandler;
+  TFresnelEventCallBack = TEventCallBack;
+  TFresnelEventHandlerRef = TEventHandlerRef;
+
+
   TFresnelUIEvent = class(TFresnelEvent)
 
   end;
@@ -73,13 +78,10 @@ Type
   TFresnelMouseEventInit = Record
     Button: TMouseButton;
     Buttons: TMouseButtons;
-    PageX: Integer;
-    PageY: Integer;
-    ScreenX: Integer;
-    ScreenY: Integer;
+    PagePos: TPoint;
+    ScreenPos: TPoint;
     Shiftstate: TShiftState;
-    X: Integer;
-    Y: Integer;
+    ControlPos : TPoint;
   end;
 
   TFresnelMouseEvent = Class(TFresnelUIEvent)
@@ -87,13 +89,14 @@ Type
     FInit : TFresnelMouseEventInit;
     function GetShiftKey(AIndex: Integer): Boolean;
   Public
-    Constructor Create(const aInit : TFresnelMouseEventInit);
-    Property PageX : Integer Read FInit.PageX;
-    Property PageY : Integer Read FInit.PageY;
-    Property ScreenX : Integer Read FInit.ScreenX;
-    Property ScreenY : Integer Read FInit.ScreenY;
-    Property X : Integer Read FInit.X;
-    Property Y : Integer Read FInit.Y;
+    Constructor Create(const aInit : TFresnelMouseEventInit); overload;
+    Procedure InitEvent(const aInit : TFresnelMouseEventInit);
+    Property PageX : Integer Read FInit.PagePos.X;
+    Property PageY : Integer Read FInit.PagePos.Y;
+    Property ScreenX : Integer Read FInit.ScreenPos.X;
+    Property ScreenY : Integer Read FInit.ScreenPos.Y;
+    Property X : Integer Read FInit.ControlPos.X;
+    Property Y : Integer Read FInit.ControlPos.Y;
     Property Buttons: TMouseButtons Read FInit.Buttons;
     Property Button : TMouseButton Read FInit.Button;
     Property ShiftState : TShiftState Read FInit.Shiftstate;
@@ -244,11 +247,15 @@ Type
    { TFresnelEventDispatcher }
 
    TFresnelEventDispatcher = Class(TEventDispatcher)
+   Private
+     Class Var _Registry : TEventRegistry;
    Protected
+     class Function CreateFresnelRegistry : TEventRegistry; virtual;
      Function GetRegistry: TEventRegistry; override;
    Public
      Class Function FresnelRegistry : TEventRegistry;
      Class Procedure RegisterFresnelEvents;
+     Class Destructor Done;
    end;
 
 
@@ -265,8 +272,26 @@ Const
     'Enter',
     'Leave',
     'MouseClick',
+    'MouseDblClick',
+    'Change',
+    'Drag',
+    'DragEnd',
+    'DragEnter',
+    'DragOver',
+    'DragLeave',
+    'DragStart',
+    'Drop',
     'MouseMove',
-    'Change'
+    'MouseDown',
+    'MouseUp',
+    'MouseOver',
+    'MouseEnter',
+    'MouseLeave',
+    'MouseWheel',
+    'FocusIn',
+    'FocusOut',
+    'Focus',
+    'Blur'
   );
 
 { TFresnelWheelEvent }
@@ -353,6 +378,11 @@ begin
 end;
 
 constructor TFresnelMouseEvent.Create(const aInit: TFresnelMouseEventInit);
+begin
+  InitEvent(aInit);
+end;
+
+procedure TFresnelMouseEvent.InitEvent(const aInit: TFresnelMouseEventInit);
 begin
   FInit:=aInit;
 end;
@@ -393,6 +423,25 @@ begin
 end;
 
 { TFresnelEventDispatcher }
+Type
+
+  { TFresnelRegistry }
+
+  TFresnelRegistry = Class(TEventRegistry)
+    Class function DefaultIDOffset : TEventID; override;
+  end;
+
+{ TFresnelRegistry }
+
+class function TFresnelRegistry.DefaultIDOffset: TEventID;
+begin
+  Result:=MaxFresnelEvents+1;
+end;
+
+class function TFresnelEventDispatcher.CreateFresnelRegistry: TEventRegistry;
+begin
+  Result:=TFresnelRegistry.Create;
+end;
 
 function TFresnelEventDispatcher.GetRegistry: TEventRegistry;
 begin
@@ -401,7 +450,9 @@ end;
 
 class function TFresnelEventDispatcher.FresnelRegistry: TEventRegistry;
 begin
-  Result:=GlobalRegistry;
+  if _Registry=Nil then
+    _Registry:=CreateFresnelRegistry;
+  Result:=_Registry;
 end;
 
 class procedure TFresnelEventDispatcher.RegisterFresnelEvents;
@@ -414,6 +465,12 @@ class procedure TFresnelEventDispatcher.RegisterFresnelEvents;
 
 begin
   R(TFresnelChangeEvent);
+  R(TFresnelMouseClickEvent);
+end;
+
+class destructor TFresnelEventDispatcher.Done;
+begin
+  FreeAndNil(_Registry);
 end;
 
 end.

src/fresnel.lclcontrols.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, Types, Math, FPImage, Fresnel.DOM, Fresnel.Layouter,
   Fresnel.Controls, fresnel.renderer, AvgLvlTree, Laz_AVL_Tree, LazLoggerBase,
-  Graphics, Controls, LCLIntf, Forms, LCLStrConsts, LResources;
+  Graphics, Controls, LCLIntf, Forms, LCLStrConsts, LResources, fresnel.events;
 
 type
   TFresnelLCLFontEngine = class;
@@ -81,6 +81,7 @@ type
     FLayoutQueued: boolean;
     FRenderer: TFresnelLCLRenderer;
     FViewport: TFresnelViewport;
+    procedure HandleClick(Sender: TObject);
     procedure OnDomChanged(Sender: TObject);
     procedure OnQueuedLayout({%H-}Data: PtrInt);
     procedure SetLayoutQueued(const AValue: boolean);
@@ -158,6 +159,7 @@ type
     FLayoutQueued: boolean;
     FRenderer: TFresnelLCLRenderer;
     FVisible: boolean;
+    procedure DoFormClick(Sender: TObject);
     function GetAllowDropFiles: Boolean;
     function GetAlphaBlend: Boolean;
     function GetAlphaBlendValue: Byte;
@@ -285,6 +287,8 @@ procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
 
 implementation
 
+uses fresnel.lclevents;
+
 function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
 var
   Font1: TFresnelLCLFont absolute Item1;
@@ -442,6 +446,27 @@ begin
   Result:=Form.AllowDropFiles;
 end;
 
+procedure TCustomFresnelForm.DoFormClick(Sender: TObject);
+
+Var
+  aInit : TFresnelMouseEventInit;
+  aEl : TFresnelElement;
+  evt : TFresnelMouseEvent;
+
+begin
+  InitMouseEvent(FForm,aInit);
+  aEl:=GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
+  if aEl=Nil then
+    aEl:=Self;
+  evt:=aEl.EventDispatcher.CreateEvent(aEl,evtClick) as TFresnelMouseEvent;
+  try
+    evt.initEvent(aInit);
+    aEl.EventDispatcher.DispatchEvent(evt);
+  finally
+    evt.Free;
+  end;
+end;
+
 procedure TCustomFresnelForm.OnFormResize(Sender: TObject);
 begin
   inherited SetWidth(Form.ClientWidth);
@@ -692,6 +717,7 @@ begin
   FForm.Name:=Name;
   FForm.Visible:=false;
   FForm.OnResize:=@OnFormResize;
+  FForm.OnClick:=@DoFormClick;
   FCanvas:=Form.Canvas;
   Form.OnPaint:=@FormPaint;
 
@@ -896,6 +922,26 @@ begin
   LayoutQueued:=true;
 end;
 
+procedure TFresnelLCLControl.HandleClick(Sender: TObject);
+Var
+  aInit : TFresnelMouseEventInit;
+  aEl : TFresnelElement;
+  evt : TFresnelMouseEvent;
+
+begin
+  InitMouseEvent(Self,aInit);
+  aEl:=FViewport.GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
+  if aEl=Nil then
+    aEl:=Self.Viewport;
+  evt:=aEl.EventDispatcher.CreateEvent(aEl,evtClick) as TFresnelMouseEvent;
+  try
+    evt.initEvent(aInit);
+    aEl.EventDispatcher.DispatchEvent(evt);
+  finally
+    evt.Free;
+  end;
+end;
+
 procedure TFresnelLCLControl.OnQueuedLayout(Data: PtrInt);
 begin
   ViewPort.ApplyCSS;
@@ -941,6 +987,7 @@ begin
   Layouter.Viewport:=ViewPort;
   FRenderer:=TFresnelLCLRenderer.Create(nil);
   FRenderer.Canvas:=Canvas;
+  OnClick:=@HandleClick;
 end;
 
 destructor TFresnelLCLControl.Destroy;

src/fresnel.lclevents.pp

@@ -0,0 +1,23 @@
+unit fresnel.lclevents;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fresnel.events, controls;
+
+Function InitMouseEvent(aForm : TControl; Out aInit : TFresnelMouseEventInit) : Boolean;
+
+implementation
+
+Function InitMouseEvent(aForm : TControl; Out aInit : TFresnelMouseEventInit) : Boolean;
+
+begin
+  aInit.ScreenPos:=Mouse.CursorPos;
+  aInit.PagePos:=aForm.ScreenToClient(Mouse.CursorPos);
+  Result:=True;
+end;
+
+end.
+

src/fresnel.lpk

@@ -7,7 +7,7 @@
     <CompilerOptions>
       <Version Value="11"/>
       <SearchPaths>
-        <OtherUnitFiles Value="$(FPCSrcDir)/packages/fcl-css/src"/>
+        <OtherUnitFiles Value="$(FPCSrcDir)/packages/fcl-css/src;css"/>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
     </CompilerOptions>
@@ -36,6 +36,18 @@
         <Filename Value="fresnel.renderer.pas"/>
         <UnitName Value="fresnel.renderer"/>
       </Item>
+      <Item>
+        <Filename Value="fresnel.lclevents.pp"/>
+        <UnitName Value="fresnel.lclevents"/>
+      </Item>
+      <Item>
+        <Filename Value="fcl.events.pas"/>
+        <UnitName Value="fcl.events"/>
+      </Item>
+      <Item>
+        <Filename Value="fresnel.events.pas"/>
+        <UnitName Value="fresnel.events"/>
+      </Item>
     </Files>
     <RequiredPkgs>
       <Item>

src/fresnel.pas

@@ -8,8 +8,8 @@ unit Fresnel;
 interface
 
 uses
-  Fresnel.Controls, Fresnel.DOM, Fresnel.Layouter, fresnel.lclcontrols, 
-  Fresnel.Renderer, LazarusPackageIntf;
+  Fresnel.Controls, Fresnel.DOM, Fresnel.Layouter, Fresnel.LCLControls, Fresnel.Renderer, fresnel.lclevents, fcl.events, 
+  fresnel.events, LazarusPackageIntf;
 
 implementation