paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 03:50:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented deleting empty submenus

Browse Source 
git-svn-id: trunk@2384 -
This commit is contained in:
mattias 2002-08-17 23:41:19 +00:00
parent e6857350d2
commit b42dd067c8
1 changed files with 50 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
lcl/interfaces/gtk/gtkobject.inc
View File

@ -3714,6 +3714,11 @@ begin
// destroy the widget // destroy the widget
DestroyWidget(Widget); DestroyWidget(Widget);
// clean up unneeded containers
if Sender is TMenuItem then begin
DestroyEmptySubmenu(TMenuItem(Sender));
end;
//writeln('>>> LM_DESTROY END ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8)); //writeln('>>> LM_DESTROY END ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8));
// remove all remaining messages to this component // remove all remaining messages to this component
QueueItem:=FMessageQueue.First; QueueItem:=FMessageQueue.First;
@ -5098,19 +5103,53 @@ begin
FinishComponentCreate(Sender, P, SetupProps); FinishComponentCreate(Sender, P, SetupProps);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TGtkObject AssignSelf } procedure TgtkObject.DestroyEmptySubmenu(Sender: TObject);
{ *Note: Assigns a pointer to self on a widget }
{------------------------------------------------------------------------------} Used by DestroyLCLComponent to destroy empty submenus, when destroying the
last menu item.
------------------------------------------------------------------------------}
procedure TgtkObject.DestroyEmptySubmenu(Sender: TObject);
var
LCLMenuItem: TMenuItem;
ParentLCLMenuItem: TMenuItem;
ParentMenuWidget: PGtkWidget;
ParentSubMenuWidget: PGtkWidget;
SubMenuWidget: PGtkMenu;
begin
if not (Sender is TMenuItem) then
RaiseException('TgtkObject.DestroyEmptySubmenu');
// destroying a TMenuItem
LCLMenuItem:=TMenuItem(Sender);
// check if in a sub menu
if (LCLMenuItem.Parent=nil) then exit;
if not (LCLMenuItem.Parent is TMenuItem) then exit;
ParentLCLMenuItem:=TMenuItem(LCLMenuItem.Parent);
if not ParentLCLMenuItem.HandleAllocated then exit;
ParentMenuWidget:=PGtkWidget(ParentLCLMenuItem.Handle);
if not GtkWidgetIsA(ParentMenuWidget,GTK_MENU_ITEM_TYPE) then exit;
ParentSubMenuWidget:=PGTKMenuItem(ParentMenuWidget)^.submenu;
if not GtkWidgetIsA(ParentSubMenuWidget,GTK_MENU_TYPE) then exit;
SubMenuWidget:=PGTKMenu(ParentSubMenuWidget);
if SubMenuWidget^.menu_shell.children=nil then begin
gtk_widget_destroy(PgtkWidget(SubMenuWidget));
gtk_object_set_data(PGtkObject(ParentMenuWidget),'ContainerMenu',nil);
end;
end;
{------------------------------------------------------------------------------
TGtkObject AssignSelf
*Note: Assigns a pointer to self on a widget
------------------------------------------------------------------------------}
procedure TgtkObject.AssignSelf(Child,Data : Pointer); procedure TgtkObject.AssignSelf(Child,Data : Pointer);
begin begin
gtk_Object_Set_Data(Pgtkobject(Child),'Self',Data); gtk_Object_Set_Data(Pgtkobject(Child),'Self',Data);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TGtkObject ShowHide } TGtkObject ShowHide
{ *Note: Show or hide a widget } *Note: Show or hide a widget
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TgtkObject.ShowHide(Sender : TObject); procedure TgtkObject.ShowHide(Sender : TObject);
procedure RaiseWrongClass; procedure RaiseWrongClass;
@ -7265,6 +7304,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.363 2003/05/18 10:42:58 mattias
implemented deleting empty submenus
Revision 1.362 2003/05/14 13:06:00 mattias Revision 1.362 2003/05/14 13:06:00 mattias
fixed setting TListBox.Selected before createhandle fixed setting TListBox.Selected before createhandle