pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8962 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-13 20:53:27 +00:00
parent a36b768a64
commit 6be867b8cd
7 changed files with 108 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@ -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;

2
components/spktoolbar/SpkToolbar/spkt_BaseItem.pas
View File

@ -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;

12
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

@ -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

34
components/spktoolbar/SpkToolbar/spkt_Items.pas
View File

@ -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;
TSpkBaseItem(Item).Appearance := nil;
TSpkBaseItem(Item).Images := nil;
TSpkBaseItem(Item).DisabledImages := nil;
TSpkBaseItem(Item).LargeImages := nil;
TSpkBaseItem(Item).DisabledLargeImages := nil;
// TSpkBaseitem(Item).ImagesWidth := 0;
// TSpkBaseItem(Item).LargeImagesWidth := 0;
end;
if not (csDestroying in Item.ComponentState) then
begin
TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := nil;
TSpkBaseItem(Item).Images := nil;
TSpkBaseItem(Item).DisabledImages := nil;
TSpkBaseItem(Item).LargeImages := nil;
TSpkBaseItem(Item).DisabledLargeImages := nil;
end;
end else
for i := 0 to Count-1 do
begin
baseItem := Items[i];
baseItem.Notify(Item, Operation);
end;
end;
end;

41
components/spktoolbar/SpkToolbar/spkt_Pane.pas
View File

@ -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;
TSpkPane(Item).Appearance := nil;
TSpkPane(Item).Images := nil;
TSpkPane(Item).DisabledImages := nil;
TSpkPane(Item).LargeImages := nil;
TSpkPane(Item).DisabledLargeImages := nil;
// TSpkPane(Item).ImagesWidth := 0;
// TSpkPane(Item).LargeImagesWidth := 0;
end;
if not(csDestroying in Item.ComponentState) then
begin
TSpkPane(Item).ToolbarDispatch := nil;
TSpkPane(Item).Appearance := nil;
TSpkPane(Item).Images := nil;
TSpkPane(Item).DisabledImages := nil;
TSpkPane(Item).LargeImages := nil;
TSpkPane(Item).DisabledLargeImages := nil;
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;

34
components/spktoolbar/SpkToolbar/spkt_Tab.pas
View File

@ -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;
TSpkTab(Item).Appearance := nil;
TSpkTab(Item).Images := nil;
TSpkTab(Item).DisabledImages := nil;
TSpkTab(Item).LargeImages := nil;
TSpkTab(Item).DisabledLargeImages := nil;
// TSpkTab(Item).ImagesWidth := 0;
// TSpkTab(Item).LargeImagesWidth := 0;
end;
if not(csDestroying in Item.ComponentState) then
begin
TSpkTab(Item).ToolbarDispatch := nil;
TSpkTab(Item).Appearance := nil;
TSpkTab(Item).Images := nil;
TSpkTab(Item).DisabledImages := nil;
TSpkTab(Item).LargeImages := nil;
TSpkTab(Item).DisabledLargeImages := nil;
end;
end else
for i := 0 to Count-1 do
begin
tab := Items[i];
tab.Panes.Notify(Item, Operation);
end;
end;
end;

13
components/spktoolbar/SpkToolbar/spkt_Types.pas
View File

@ -28,24 +28,19 @@ type
FListState: TSpkListState;
FRootComponent: TComponent;
// *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list ***
// *** Methods responding to changes ***
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
// *** Reader, writer and operation designtime and DFM/LFM
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;