- Optimizing of the TAQPMessages plugin

- Memory leak fixed and some code optimizations in the StickyTools example
WladiD · Dec 18, 2017 · f48c917 · f48c917
1 parent d2d1c93
commit f48c917
Show file tree

Hide file tree

Showing 4 changed files with 123 additions and 113 deletions.
diff --git a/AQPMessages.pas b/AQPMessages.pas
@@ -12,18 +12,21 @@
  * The Original Code is AQPMessages.pas.
  *
  * The Initial Developer of the Original Code is Waldemar Derr.
- * Portions created by Waldemar Derr are Copyright (C) 2014 Waldemar Derr.
+ * Portions created by Waldemar Derr are Copyright (C) Waldemar Derr.
  * All Rights Reserved.
  *
- * @author Waldemar Derr <mail@wladid.de>
+ * @author Waldemar Derr <furevest@gmail.com>
  *}
 
 unit AQPMessages;
 
 interface
 
 uses
-  SysUtils, Classes, Controls, Windows, Messages, Contnrs, AnyiQuack;
+  System.SysUtils, System.Classes, System.Contnrs, System.Types, Vcl.Controls, Winapi.Windows,
+  Winapi.Messages,
+
+  AnyiQuack;
 
 type
   TAQPMessages = class(TAQPlugin)
@@ -132,20 +135,20 @@ class procedure TAQPMessages.DispatchWindowProc(Control: TControl; Message: TMes
       .Each(
         function(AQ: TAQ; O: TObject): Boolean
         var
-          MsgPlugin: TAQPMessages;
+          MsgPlugin: TAQPMessages absolute O;
+          PluginAQ: TAQ;
         begin
-          MsgPlugin := TAQPMessages(O);
-          if (MsgPlugin.FListenForMsg = Message.Msg) and
-            (MsgPlugin.WorkAQ.IndexOf(Control) >= 0) then
+          Result := True;
+
+          if MsgPlugin.FListenForMsg = Message.Msg then
           begin
-            MsgPlugin.Each(
-              function(AQ: TAQ; O: TObject): Boolean
-              begin
-                MsgPlugin.FEachMsgFunction(AQ, O, Message);
-                Result := True;
-              end);
+            PluginAQ := MsgPlugin.WorkAQ;
+
+            // It looks dangerous, but as we know that we have only one control per TAQ instance
+            // for this purposes, we must rely on it.
+            if PluginAQ[0] = Control then
+              Result := MsgPlugin.FEachMsgFunction(PluginAQ, PluginAQ[0], Message);
           end;
-          Result := True;
         end);
   finally
     FInDispatchWindowProc := False;
@@ -220,10 +223,8 @@ function TAQPMessages.EachMessage(Msg: Cardinal; EachMsgFunction: TEachMiscFunct
       Result := True;
       if not (O is TControl) then
         Exit;
-      {**
-       * Jedes TControl muss in einer eigenen TAQ-Instanz residieren, da es sonst keinen
-       * Zusammenhang zwischen der Message und dem zugehörigen TControl gibt.
-       *}
+
+      // Each TControl resists in its own TAQ instance
       MsgPlugin := Take(O).Plugin<TAQPMessages>;
 
       MsgPlugin.FEachMsgFunction := EachMsgFunction;
@@ -276,7 +277,7 @@ class function TAQPMessages.ListenersExistsFor(Control: TControl; Msg: Cardinal;
           ((Msg = 0) and (MsgPlugin.FListenForMsg > 0)) or
           ((Msg > 0) and (MsgPlugin.FListenForMsg = Msg))
         ) and
-        MsgPlugin.WorkAQ.Contains(Control) and
+        (MsgPlugin.WorkAQ[0] = Control) and
         MatchID(ListenID, MsgPlugin.FListenID);
       Result := not ListenersExists;
     end);
@@ -341,7 +342,7 @@ procedure TWndProcList.HookControl(Control: TControl);
   P: PWndProcRec;
   Proc: TWndMethod;
 begin
-  if GetIndex(Control) >= 0 then
+  if GetIndex(Control) >= 0 then
     Exit;
 
   New(P);

diff --git a/Examples/StickyTools/AQPStickyTools.pas b/Examples/StickyTools/AQPStickyTools.pas
@@ -27,6 +27,8 @@ implementation
 {** TAQPStickyTools **}
 
 procedure TAQPStickyTools.Autorun;
+const
+  MessageListenID = 3;
 begin
   inherited Autorun;
 
@@ -39,19 +41,20 @@ procedure TAQPStickyTools.Autorun;
       if not (O is TToolsForm) then
         Exit;
       if not TAQPMessages
-        .ListenersExistsFor(TControl(ToolsForm.Owner), WM_WINDOWPOSCHANGED) then
+        .ListenersExistsFor(TControl(ToolsForm.Owner), WM_WINDOWPOSCHANGED, MessageListenID) then
         Take(ToolsForm.Owner)
           .Plugin<TAQPMessages>
           .EachMessage(WM_WINDOWPOSCHANGED,
             function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
             begin
-              AQ
-                .ChildrenChain
-                  .Each(StickyEach)
-                  .Die
-                .EndChain;
+              AQ.ChildrenChain //.DebugMessage('Nach ChildrenChain')
+                  .FilterChain(TToolsForm) //.DebugMessage('Nach FilterChain')
+                    .Each(StickyEach)
+                  .EndChain.Die
+                .EndChain.Die;
+
               Result := False;
-            end);
+            end, MessageListenID);
     end);
 end;
 
@@ -80,6 +83,6 @@ function TAQPStickyTools.StickyEach(AQ: TAQ; O: TObject): Boolean;
 end;
 
 initialization
-  TAQPStickyTools.AnimateStick := TRUE;
+  TAQPStickyTools.AnimateStick := True;
 
 end.
diff --git a/Examples/StickyTools/Main.dfm b/Examples/StickyTools/Main.dfm
@@ -16,6 +16,7 @@ object MainForm: TMainForm
   OldCreateOrder = False
   Position = poScreenCenter
   OnCreate = FormCreate
+  OnShow = FormShow
   DesignSize = (
     645
     452)

diff --git a/Examples/StickyTools/Main.pas b/Examples/StickyTools/Main.pas
@@ -12,6 +12,9 @@   TMainForm = class(TForm)
     AnimateCheckBox: TCheckBox;
     procedure FormCreate(Sender: TObject);
     procedure AnimateCheckBoxClick(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+    function LabelBlink(AQ: TAQ; O: TObject): Boolean;
   end;
 
 var
@@ -34,9 +37,17 @@ procedure TMainForm.AnimateCheckBoxClick(Sender: TObject);
 end;
 
 procedure TMainForm.FormCreate(Sender: TObject);
+
+  function CreateToolsForm: TToolsForm;
+  begin
+    Result := TToolsForm.Create(Self);
+    Result.PopupParent := Self;
+  end;
+
 var
   PaddingLeft, PaddingTop, ExitSizeMoveCount, WindowPosChangedCount: Integer;
-  BlinkEach: TEachFunction;
+  TF: TToolsForm;
+  MsgPlugin: TAQPMessages;
 begin
   PaddingLeft := GetSystemMetrics(SM_CXSIZEFRAME)
     + GetSystemMetrics(SM_CXBORDER)
@@ -47,36 +58,70 @@ procedure TMainForm.FormCreate(Sender: TObject);
     + GetSystemMetrics(SM_CXPADDEDBORDER)
     + 1;
 
-  with TToolsForm.Create(Self) do
-  begin
-    PopupParent := Self;
-    Top := Self.Top;
-    Left := Self.Left - 80 - PaddingLeft;
-    Height := 300;
-    Width := 80;
-    Show;
-  end;
+  TF := CreateToolsForm;
+  TF.Top := Self.Top;
+  TF.Left := Self.Left - 80 - PaddingLeft;
+  TF.Height := 300;
+  TF.Width := 80;
+  TF.Show;
+
+  TF := CreateToolsForm;
+  TF.Top := Self.Top + Self.Height + PaddingTop;
+  TF.Left := Self.Left;
+  TF.Height := 80;
+  TF.Width := Self.Width;
+  TF.Show;
+
+  TF := CreateToolsForm;
+  TF.Top := Self.Top + PaddingTop + GetSystemMetrics(SM_CYCAPTION) - 1;
+  TF.Left := Self.Left + Self.ClientWidth - 202;
+  TF.Height := 200;
+  TF.Width := 200;
+  TF.Show;
 
-  with TToolsForm.Create(Self) do
-  begin
-    PopupParent := Self;
-    Top := Self.Top + Self.Height + PaddingTop;
-    Left := Self.Left;
-    Height := 80;
-    Width := Self.Width;
-    Show;
-  end;
-
-  with TToolsForm.Create(Self) do
-  begin
-    PopupParent := Self;
-    Top := Self.Top + PaddingTop + GetSystemMetrics(SM_CYCAPTION) - 1;
-    Left := Self.Left + Self.ClientWidth - 202;
-    Height := 200;
-    Width := 200;
-    Show;
-  end;
+  ExitSizeMoveCount := 0;
+  WindowPosChangedCount := 0;
+  MsgPlugin := Take(Self).Plugin<TAQPMessages>;
+
+  MsgPlugin.EachMessage(WM_EXITSIZEMOVE,
+    function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
+    begin
+      Inc(ExitSizeMoveCount);
+      Caption := 'WM_EXITSIZEMOVE ' + IntToStr(ExitSizeMoveCount);
+      Result := True;
+    end, 111);
+  MsgPlugin.EachMessage(WM_WINDOWPOSCHANGED,
+    function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
+    begin
+      Inc(WindowPosChangedCount);
+      Caption := 'WM_WINDOWPOSCHANGED ' + IntToStr(WindowPosChangedCount);
+      Result := True;
+    end, 111);
+  MsgPlugin.EachMessage(WM_LBUTTONDOWN,
+    function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
+    begin
+      Take(O)
+        .CancelAnimations(BGColorAniID)
+        .Plugin<TAQPControlAnimations>
+        .BackgroundColorAnimation(clBlack, 250, BGColorAniID, TAQ.Ease(etCubic));
+      TForm(O).Color := clBlack;
+      Result := True;
+    end);
+  MsgPlugin.EachMessage(WM_LBUTTONUP,
+    function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
+    begin
+      Take(O)
+        .CancelAnimations(BGColorAniID)
+        .Plugin<TAQPControlAnimations>
+        .BackgroundColorAnimation(clBtnFace, 250, BGColorAniID, TAQ.Ease(etCubic));
+      Result := True;
+    end);
+
+  Take(Label1).Each(LabelBlink);
+end;
 
+procedure TMainForm.FormShow(Sender: TObject);
+begin
   Take(Self)
     .ChildrenChain
       .FilterChain(TToolsForm)
@@ -85,65 +130,25 @@ procedure TMainForm.FormCreate(Sender: TObject);
       .EndChain
       .Die
     .EndChain;
+end;
 
-  ExitSizeMoveCount := 0;
-  WindowPosChangedCount := 0;
-  with Take(Self).Plugin<TAQPMessages> do
-  begin
-    EachMessage(WM_EXITSIZEMOVE,
-      function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
-      begin
-        Inc(ExitSizeMoveCount);
-        Caption := 'WM_EXITSIZEMOVE ' + IntToStr(ExitSizeMoveCount);
-        Result := True;
-      end, 111);
-    EachMessage(WM_WINDOWPOSCHANGED,
-      function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
-      begin
-        Inc(WindowPosChangedCount);
-        Caption := 'WM_WINDOWPOSCHANGED ' + IntToStr(WindowPosChangedCount);
-        Result := True;
-      end, 111);
-    EachMessage(WM_LBUTTONDOWN,
-      function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
-      begin
-        Take(O)
-          .CancelAnimations(BGColorAniID)
-          .Plugin<TAQPControlAnimations>
-          .BackgroundColorAnimation(clBlack, 250, BGColorAniID, TAQ.Ease(etCubic));
-        TForm(O).Color := clBlack;
-        Result := True;
-      end);
-    EachMessage(WM_LBUTTONUP,
-      function(AQ: TAQ; O: TObject; Message: TMessage): Boolean
+function TMainForm.LabelBlink(AQ: TAQ; O: TObject): Boolean;
+var
+  TargetColor: TColor;
+begin
+  if TLabel(O).Font.Color = clBlack then
+    TargetColor := clRed
+  else
+    TargetColor := clBlack;
+
+  AQ
+    .Plugin<TAQPControlAnimations>
+    .FontColorAnimation(TargetColor, 500, FontColorAniID, TAQ.Ease(etQuint),
+      procedure(Sender: TObject)
       begin
-        Take(O)
-          .CancelAnimations(BGColorAniID)
-          .Plugin<TAQPControlAnimations>
-          .BackgroundColorAnimation(clBtnFace, 250, BGColorAniID, TAQ.Ease(etCubic));
-        Result := True;
+        Take(Sender).EachDelay(200, LabelBlink);
       end);
-  end;
-
-  BlinkEach := function(AQ: TAQ; O: TObject): Boolean
-  var
-    TargetColor: TColor;
-  begin
-    if TLabel(O).Font.Color = clBlack then
-      TargetColor := clRed
-    else
-      TargetColor := clBlack;
-
-    AQ
-      .Plugin<TAQPControlAnimations>
-      .FontColorAnimation(TargetColor, 500, FontColorAniID, TAQ.Ease(etQuint),
-        procedure(Sender: TObject)
-        begin
-          Take(Sender).EachDelay(200, BlinkEach);
-        end);
-    Result := False;
-  end;
-  Take(Label1).Each(BlinkEach);
+  Result := False;
 end;
 
 end.