SpkToolbar: Fix crash when a popupmenu used by a button is destroyed.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8962 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/spktoolbar/SpkToolbar/SpkToolbar.pas

@@ -1166,6 +1166,7 @@ var
   Tab: TSpkTab;
   Pane: TSpkPane;
   Item: TSpkBaseItem;
+  i: Integer;
 begin
   inherited;
 
@@ -1195,7 +1196,24 @@ begin
       Pane := Item.Parent as TSpkPane;
       Pane.FreeingItem(Item);
     end;
-  end;
+  end else
+  if AComponent is TCustomImageList then
+  begin
+    if AComponent = DisabledImages then
+      DisabledImages := nil;
+    if AComponent = DisabledLargeImages then
+      DisabledLargeImages := nil;
+    if AComponent = Images then
+      Images := nil;
+    if AComponent = LargeImages then
+      LargeImages := nil;
+  end else
+  if AComponent = FMenuButtonDropDownMenu then
+    FMenuButtonDropDownMenu := nil;
+
+  // Remove DropdownMenu from button items.
+  if AComponent is TPopupMenu then
+    Tabs.Notify(AComponent, Operation);
 end;
 
 procedure TSpkToolbar.NotifyAppearanceChanged;

components/spktoolbar/SpkToolbar/spkt_BaseItem.pas

@@ -68,6 +68,8 @@ type
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
       X, Y: Integer); virtual; abstract;
 
+    procedure Notify(Item: TComponent; Operation: TOperation); virtual; abstract;
+
     function GetWidth: integer; virtual; abstract;
     function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract;
     function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract;

components/spktoolbar/SpkToolbar/spkt_Buttons.pas

@@ -15,7 +15,7 @@ unit spkt_Buttons;
 
 interface
 
-uses
+uses   LazLoggerBase,
   Graphics, Classes, Types, Controls, Menus, ActnList, Math,
   Dialogs, ImgList, Forms,
   SpkGUITools, SpkGraphTools, SpkMath,
@@ -127,6 +127,7 @@ type
 
     function GetRootComponent: TComponent;
     function IsRightToLeft: Boolean;
+    procedure Notify(Item: TComponent; Operation: TOperation); override;
 
     property ActionLink: TSpkButtonActionLink read FActionLink;
     property Checked: Boolean read GetChecked write SetChecked default false;
@@ -528,6 +529,15 @@ begin
   Result := (GetRootComponent as TControl).IsRightToLeft;
 end;
 
+procedure TSpkBaseButton.Notify(Item: TComponent; Operation: TOperation);
+begin
+  if (Operation = opRemove) and (Item = FDropDownMenu) then
+  begin
+    DropDownMenu := nil;
+    DebugLn('[TSpkBaseButton.Notify] Button "' + caption + '" removed ' + Item.ClassName);
+  end;
+end;
+
 procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin

components/spktoolbar/SpkToolbar/spkt_Items.pas

@@ -15,7 +15,7 @@ unit spkt_Items;
 
 interface
 
-uses
+uses             LazLoggerBase,
   Classes, Controls, SysUtils, Dialogs,
   spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types,
   spkt_Buttons, spkt_Checkboxes;
@@ -102,11 +102,17 @@ begin
 end;
 
 procedure TSpkItems.Notify(Item: TComponent; Operation: TOperation);
+var
+  i: Integer;
+  baseItem: TSpkBaseItem;
 begin
   inherited Notify(Item, Operation);
 
+  DebugLn('[TSpkItems.Notify] Removing ' + Item.ClassName);
+
   case Operation of
     opInsert:
+      if Item is TSpkBaseItem then
       begin
         // Setting the dispatcher to nil will cause that during the ownership
         // assignment, the Notify method will not be called
@@ -122,17 +128,23 @@ begin
       end;
 
     opRemove:
-      if not (csDestroying in Item.ComponentState) then
+      if Item is TSpkBaseItem then
       begin
-        TSpkBaseItem(Item).ToolbarDispatch := nil;
+        if not (csDestroying in Item.ComponentState) then
-        TSpkBaseItem(Item).Appearance := nil;
+        begin
-        TSpkBaseItem(Item).Images := nil;
+          TSpkBaseItem(Item).ToolbarDispatch := nil;
-        TSpkBaseItem(Item).DisabledImages := nil;
+          TSpkBaseItem(Item).Appearance := nil;
-        TSpkBaseItem(Item).LargeImages := nil;
+          TSpkBaseItem(Item).Images := nil;
-        TSpkBaseItem(Item).DisabledLargeImages := nil;
+          TSpkBaseItem(Item).DisabledImages := nil;
-//        TSpkBaseitem(Item).ImagesWidth := 0;
+          TSpkBaseItem(Item).LargeImages := nil;
-//        TSpkBaseItem(Item).LargeImagesWidth := 0;
+          TSpkBaseItem(Item).DisabledLargeImages := nil;
-      end;
+        end;
+      end else
+        for i := 0 to Count-1 do
+        begin
+          baseItem := Items[i];
+          baseItem.Notify(Item, Operation);
+        end;
   end;
 end;
 

components/spktoolbar/SpkToolbar/spkt_Pane.pas

@@ -15,7 +15,7 @@ unit spkt_Pane;
 
 interface
 
-uses
+uses                   LazLoggerBase,
   Graphics, Controls, Classes, SysUtils, Math, Dialogs,
   SpkGraphTools, SpkGUITools, SpkMath,
   spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions,
@@ -172,7 +172,7 @@ type
     function Add: TSpkPane;
     function Insert(AIndex: integer): TSpkPane;
 
-    // *** Reaction to changes in the list ***
+    // *** Reaction to changes ***
     procedure Notify(Item: TComponent; Operation: TOperation); override;
     procedure Update; override;
 
@@ -398,11 +398,11 @@ begin
 
   // Pane label
   ABuffer.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
+  w := ABuffer.Canvas.TextWidth(FCaption);  // Panel label width
 
-  // Handle visibility of 'More options' button to set Pane label pos
+  // Handle visibility of 'More options' button to set Pane label position
   if FShowMoreOptionsButton then
   begin
-    w := ABuffer.Canvas.TextWidth(FCaption);
     if isRTL then
       x := FRect.Right - (FRect.Width - PaneMoreOptionsButtonWidth - w) div 2 - w
     else
@@ -1347,10 +1347,16 @@ begin
 end;
 
 procedure TSpkPanes.Notify(Item: TComponent; Operation: TOperation);
+var
+  i: Integer;
+  pane: TSpkPane;
 begin
   inherited Notify(Item, Operation);
+  DebugLn('[TSpkPanes.Notify] Removing ' + Item.ClassName);
+
   case Operation of
     opInsert:
+      if Item is TSpkPane then
       begin
         // Setting the dispatcher to nil will cause that during the
         // ownership assignment, the Notify method will not be called
@@ -1365,17 +1371,24 @@ begin
         TSpkPane(Item).ToolbarDispatch := FToolbarDispatch;
       end;
     opRemove:
-      if not(csDestroying in Item.ComponentState) then
+      if Item is TSpkPane then
       begin
-        TSpkPane(Item).ToolbarDispatch := nil;
+        if not(csDestroying in Item.ComponentState) then
-        TSpkPane(Item).Appearance := nil;
+        begin
-        TSpkPane(Item).Images := nil;
+          TSpkPane(Item).ToolbarDispatch := nil;
-        TSpkPane(Item).DisabledImages := nil;
+          TSpkPane(Item).Appearance := nil;
-        TSpkPane(Item).LargeImages := nil;
+          TSpkPane(Item).Images := nil;
-        TSpkPane(Item).DisabledLargeImages := nil;
+          TSpkPane(Item).DisabledImages := nil;
-//        TSpkPane(Item).ImagesWidth := 0;
+          TSpkPane(Item).LargeImages := nil;
-//        TSpkPane(Item).LargeImagesWidth := 0;
+          TSpkPane(Item).DisabledLargeImages := nil;
-      end;
+        end;
+      end else
+        for i := 0 to Count-1 do
+        begin
+          pane := Items[i];
+          DebugLn(['pane ', pane.Caption]);
+          pane.Items.Notify(Item, Operation);
+        end;
   end;
 end;
 

components/spktoolbar/SpkToolbar/spkt_Tab.pas

@@ -20,7 +20,7 @@ unit spkt_Tab;
 
 interface
 
-uses
+uses                  LazLoggerBase,
   Graphics, Controls, Classes, SysUtils, Math,
   SpkMath,
   spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions,
@@ -686,11 +686,17 @@ begin
 end;
 
 procedure TSpkTabs.Notify(Item: TComponent; Operation: TOperation);
+var
+  i: Integer;
+  tab: TSpkTab;
 begin
   inherited Notify(Item, Operation);
 
+  DebugLn('[TSpkTabs.Notify] Removing ' + Item.ClassName);
+
   case Operation of
     opInsert:
+      if Item is TSpkTab then
       begin
         // Setting the dispatcher to nil will cause that during the
         // ownership assignment, the Notify method will not be called
@@ -705,17 +711,23 @@ begin
         TSpkTab(Item).ToolbarDispatch := self.FToolbarDispatch;
       end;
     opRemove:
-      if not(csDestroying in Item.ComponentState) then
+      if (Item is TSpkTab) then
       begin
-        TSpkTab(Item).ToolbarDispatch := nil;
+        if not(csDestroying in Item.ComponentState) then
-        TSpkTab(Item).Appearance := nil;
+        begin
-        TSpkTab(Item).Images := nil;
+          TSpkTab(Item).ToolbarDispatch := nil;
-        TSpkTab(Item).DisabledImages := nil;
+          TSpkTab(Item).Appearance := nil;
-        TSpkTab(Item).LargeImages := nil;
+          TSpkTab(Item).Images := nil;
-        TSpkTab(Item).DisabledLargeImages := nil;
+          TSpkTab(Item).DisabledImages := nil;
-  //      TSpkTab(Item).ImagesWidth := 0;
+          TSpkTab(Item).LargeImages := nil;
-//        TSpkTab(Item).LargeImagesWidth := 0;
+          TSpkTab(Item).DisabledLargeImages := nil;
-      end;
+        end;
+      end else
+        for i := 0 to Count-1 do
+        begin
+          tab := Items[i];
+          tab.Panes.Notify(Item, Operation);
+        end;
   end;
 end;
 

components/spktoolbar/SpkToolbar/spkt_Types.pas

@@ -28,24 +28,19 @@ type
     FListState: TSpkListState;
     FRootComponent: TComponent;
 
-    // *** Metody reakcji na zmiany w liœcie ***
+    // *** Methods responding to changes ***
-    // *** Methods responding to changes in list ***
     procedure Notify({%H-}Item: TComponent; {%H-}Operation: TOperation); virtual;
     procedure Update; virtual;
 
-    // *** Wewnêtrzne metody dodawania i wstawiania elementów ***
-    // *** Gettery i settery ***
-
     // *** Internal methods for adding and inserting elements ***
     // *** Getters and setters ***
     function GetItems(AIndex: integer): TComponent; virtual;
 
   public
-    // *** Konstruktor, destruktor ***
+    // *** Constructor, destructor ***
     constructor Create(ARootComponent : TComponent); reintroduce; virtual;
     destructor Destroy; override;
 
-    // *** Obs³uga listy ***
     // *** List operations ***
     procedure AddItem(AItem: TComponent);
     procedure InsertItem(AIndex: integer; AItem: TComponent);
@@ -58,8 +53,7 @@ type
     procedure Exchange(item1, item2: integer);
     procedure Move(IndexFrom, IndexTo: integer);
 
-    // *** Reader, writer i obs³uga designtime i DFM ***
+    // *** Reader, writer and operation designtime and DFM/LFM
-    // *** Reader, writer and operation designtime and DFM
     procedure WriteNames(Writer: TWriter); virtual;
     procedure ReadNames(Reader: TReader); virtual;
     procedure ProcessNames(Owner: TComponent); virtual;
@@ -74,7 +68,6 @@ type
     FParent: TComponent;
     FCollection: TSpkCollection;
   public
-    // *** Obs³uga parenta ***
     // *** Parent operations ***
     function HasParent: boolean; override;
     function GetParentComponent: TComponent; override;