* Implemented a global MessageHook feature where one component can register and listen to another components messages.

3 files changed, 61 insertions, 2 deletions

diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index e9da7422..d4b32b99 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -174,8 +174,17 @@ type
     procedure   DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); virtual;
     procedure   DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); virtual;
   end;
+  
+
+  TMsgHookItem = class
+    Dest: TObject;
+    Listener: TObject;
+    MsgCode: integer;
+  end;
 
 
+  { TfpgApplication }
+
   TfpgApplication = class(TfpgApplicationImpl)
   protected
     FDisplayParams: string;
@@ -183,6 +192,7 @@ type
     FScreenHeight: integer;
     FDefaultFont: TfpgFont;
     FFontResList: TList;
+    FMessageHookList: TFPList;
     procedure   FreeFontRes(afontres: TfpgFontResource);
     procedure   InternalInit;
     procedure   RunMessageLoop;
@@ -195,6 +205,8 @@ type
     procedure   Run;
     procedure   Flush;
     procedure   ProcessMessages;
+    procedure   SetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject);
+    procedure   UnsetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject);
     property    ScreenWidth: integer read FScreenWidth;
     property    ScreenHeight: integer read FScreenHeight;
     property    DefaultFont: TfpgFont read FDefaultFont;
@@ -703,7 +715,8 @@ begin
   FScreenWidth    := -1;
   FScreenHeight   := -1;
   FModalFormStack := TList.Create;
-
+  FMessageHookList := TFPList.Create;
+  
   try
     inherited Create(aparams);
 
@@ -746,6 +759,10 @@ begin
   FFontResList.Free;
 
   FreeAndNil(FModalFormStack);
+  
+  for i := 0 to FMessageHookList.Count-1 do
+    TMsgHookItem(FMessageHookList[i]).Free;
+  FreeAndNil(FMessageHookList);
 
   for i := uMsgQueueList.Count-1 downto 0 do
   begin
@@ -850,6 +867,35 @@ begin
   end;
 end;
 
+procedure TfpgApplication.SetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject);
+var
+  oItem: TMsgHookItem;
+begin
+  oItem := TMsgHookItem.Create;
+  oItem.Dest := AWidget;
+  oItem.Listener := AListener;
+  oItem.MsgCode := AMsgCode;
+  FMessageHookList.Add(oItem);
+end;
+
+procedure TfpgApplication.UnsetMessageHook(AWidget: TObject;
+  const AMsgCode: integer; AListener: TObject);
+var
+  oItem: TMsgHookItem;
+  i: integer;
+begin
+  for i := 0 to FMessageHookList.Count-1 do
+  begin
+    oItem := TMsgHookItem(FMessageHookList.Items[i]);
+    if (oItem.Dest = AWidget) and (oItem.Listener = AListener) and (oItem.MsgCode = AMsgCode) then
+    begin
+      FMessageHookList.Delete(i);
+      oItem.Free;
+      Exit;
+    end;
+  end;
+end;
+
 procedure TfpgApplication.WaitWindowMessage(atimeoutms: integer);
 begin
   if IsMultiThread then
diff --git a/src/corelib/gfx_msgqueue.inc b/src/corelib/gfx_msgqueue.inc
index e498d7a9..9ddda9b4 100644
--- a/src/corelib/gfx_msgqueue.inc
+++ b/src/corelib/gfx_msgqueue.inc
@@ -184,6 +184,9 @@ begin
 end;
 
 procedure fpgDeliverMessage(var msg: TfpgMessageRec);
+var
+  oItem: TMsgHookItem;
+  i: integer;
 begin
   if msg.MsgCode = FPGM_KILLME then
     msg.Dest.Free
@@ -191,6 +194,15 @@ begin
   begin
     try
       msg.Dest.Dispatch(msg);
+      if fpgApplication.FMessageHookList.Count > 0 then
+      begin
+        for i := 0 to fpgApplication.FMessageHookList.Count - 1 do
+        begin
+          oItem := TMsgHookItem(fpgApplication.FMessageHookList.Items[i]);
+          if (msg.Dest = oItem.Dest) and (msg.MsgCode = oItem.MsgCode) then
+            oItem.Listener.Dispatch(msg);
+        end;
+      end;
     except
       on E: Exception do
         {$IFDEF DEBUG}writeln('fpgDeliverMessage Caught Exception: ' + E.Message){$ENDIF};
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index e1f68e6e..990a020f 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -33,6 +33,8 @@ type
     FOnPaint: TPaintEvent;
     FOnKeyPress: TKeyPressEvent;
     FOnScreen: boolean;
+    procedure   SetActiveWidget(const AValue: TfpgWidget);
+  protected
     procedure   MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
     procedure   MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
     procedure   MsgMove(var msg: TfpgMessageRec); message FPGM_MOVE;
@@ -46,7 +48,6 @@ type
     procedure   MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER;
     procedure   MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT;
     procedure   MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL;
-    procedure   SetActiveWidget(const AValue: TfpgWidget);
   protected
     FFormDesigner: TObject;
     FVisible: boolean;