TB2Merge, Version 0.3 (alt)

unit TB2Merge;

{
  TB2Merge.pas
  Copyright (C) 2005 Volker Siebert, Germany
  All rights reserved.

  The contents of this file are subject to the Mozilla Public License
  Version 1.1 (the "License"); you may not use this file except in
  compliance with the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL/

  Software distributed under the License is distributed on an "AS IS"
  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
  License for the specific language governing rights and limitations
  under the License.

  Changelog
  ---------

  2005-06-27: Version 0.2
    - Added "TBFixImageList" to merge toolbars with different image lists
    - Changed the way how separator items are grouped, see "FindEndOfGroup"

  2005-06-25: Version 0.1
    - Initial version
}

interface

uses
  Classes, SysUtils, Menus, Controls, ImgList, TB2Dock, TB2Item;

type
  { TTBUnmergeItem holds a single atomic operation for an "unmerge". This is
    done by simply moving the item back to its old parent and position.
  }
  PTBUnmergeItem = ^TTBUnmergeItem;
  TTBUnmergeItem = record
    Next: PTBUnmergeItem;     // Single linked list
    Item: TTBCustomItem;      // Which item
    Parent: TTBCustomItem;    // Old parent
    ParentIndex: Integer;     // Old parent index
  end;

  { These are the options for the merge process. They tell TBMergeItems
    what to do with a block of items having the same GroupIndex.

    If you neither specify moKeepTarget nor moRecursive, the default action
    is to replace the entire target block by the source block. This mimics
    the behaviour of the VCL when merging two menus.

    With moKeepTarget, we try to find a matching source entry for each target
    item (read below about how a matching entry is identified). If we find
    one, the target item is replaced by this match. If not, the target item
    will be kept in place. After that the remaining unused source items are
    appended at the end of the target block.

    moRecursive works like moKeepTarget, i.e., we try to find a matching
    entry for each target item. The difference comes when we find two
    matching items with submenus. Here the target item is kept (including
    all of its properties) and instead the both submenus' items are merged
    recursively.

    By default the system identifies matching entries by their name, i.e.,
    tbMainMenuBar.miFileSave and tbChildMenuBar.miFileSave match because
    they have the same name.

    Using moMatchByCaption or moMatchByTag changes this behaviour and items
    are identified by their caption resp. by their tag number.
  }
  TTBMergeOption = (
    moKeepTarget,             // Keep non-matching target entries
    moRecursive,              // Recurse into matching items' submenus
    moMatchByCaption,         // Identify matching items by their caption
    moMatchByTag              // Identify matching items by their tag
  );

  TTBMergeOptions = set of TTBMergeOption;

function  TBMergeItems(Target, Source: TTBCustomItem; Options: TTBMergeOptions): PTBUnmergeItem;
procedure TBUnmergeItems(Target, Source: TTBCustomItem; List: PTBUnmergeItem);
procedure TBFreeUnmergeItems(List: PTBUnmergeItem);
procedure TBFixImageList(Items: TTBCustomItem; Images: TCustomImageList);

type
  { TTBMergedItems is just an OOP wrapper for the functions above. Upon
    creation, the two sets of items are merged and they are automatically
    unmerged when the object is deleted.
  }
  TTBMergedItems = class(TObject)
  private
    FTarget: TTBCustomItem;
    FSource: TTBCustomItem;
    FUnmergeItems: PTBUnmergeItem;
    FOptions: TTBMergeOptions;
    FTargetComponent: TComponent;
    FSourceComponent: TComponent;

  public
    constructor Create(ATarget, ASource: TTBCustomItem; Options: TTBMergeOptions);
    destructor Destroy; override;

    procedure Merge;
    procedure Unmerge;
    procedure Dispose;

    property Target: TTBCustomItem read FTarget;
    property Source: TTBCustomItem read FSource;
    property UnmergeItems: PTBUnmergeItem read FUnmergeItems;
    property Options: TTBMergeOptions read FOptions;
    property TargetComponent: TComponent read FTargetComponent write FTargetComponent;
    property SourceComponent: TComponent read FSourceComponent write FSourceComponent;
  end;

type
  { Don't use a TTBToolbarMerger component directly, use the one returned
    by the function "ToolbarMerger".

    To merge your TB2K/TBX menu bars with the main form's menu bar, add the
    following code to your MDI child's FormActivate, FormDeactivate and
    FormDestroy events.

    Example:

    procedure TfrmChild.FormActivate(Sender: TObject);
    begin
      ToolbarMerger.Merge(frmMain.tbMainMenu, tbChildMenu, [moRecursive]);
    end;

    procedure TfrmChild.FormDeactivate(Sender: TObject);
    begin
      ToolbarMerger.Unmerge(frmMain.tbMainMenu, tbChildMenu);
    end;

    procedure TfrmChild.FormDestroy(Sender: TObject);
    begin
      ToolbarMerger.UnmergeAll(tbChildMenu);
    end;
  }
  TTBToolbarMerger = class(TComponent)
  private
    FMergedItems: TList;
    FPatchOnFree: PInteger;

    function GetCount: Integer;
    function GetItem(Index: Integer): TTBMergedItems;

  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Merge(Target, Source: TComponent; Options: TTBMergeOptions);
    procedure Unmerge(Target, Source: TComponent);
    procedure UnmergeAll(Comp: TComponent);
    procedure Delete(Index: Integer);
    function  IsMerged(Target: TComponent): Integer;
    function  IsMergedWith(Source: TComponent): Integer;
    procedure Clear;

    procedure PatchOnFree(Ptr: Pointer);

    property Count: Integer read GetCount stored false;
    property Items[Index: Integer]: TTBMergedItems read GetItem stored false;
  end;

function ToolbarMerger: TTBToolbarMerger;

implementation

{$BOOLEVAL OFF}

uses
  Windows, Forms;

{######################################################################
 Misc. declarations
 ######################################################################
}

{ TTBItemAccess is just a hack to get access to the protected members of
  TTBCustomItem, especially: "tbisSubmenu in TTBItemAccess(i).ItemStyle".
}
type
  TTBItemAccess = class(TTBCustomItem);

{ Notify the item that it's going to be updated (a lot)
}
procedure BeginUpdateItem(Item: TTBCustomItem);
begin
  if Assigned(Item.ParentComponent) then
    if Item.ParentComponent is TTBCustomDockableWindow
      then TTBCustomDockableWindow(Item.ParentComponent).BeginUpdate;

  Item.ViewBeginUpdate;
end;

{ Notify the item that all updates are finished
}
procedure EndUpdateItem(Item: TTBCustomItem);
begin
  Item.ViewEndUpdate;

  if Assigned(Item.ParentComponent) then
    if Item.ParentComponent is TTBCustomDockableWindow
      then TTBCustomDockableWindow(Item.ParentComponent).EndUpdate;
end;

{ Get the root item for the given component
}
function GetComponentItems(Comp: TComponent): TTBCustomItem;
var Intf: ITBItems;
begin
  if not Assigned(Comp) then
    Result := nil
  else if Comp is TTBCustomItem then
    Result := TTBCustomItem(Comp)
  else if Comp.GetInterface(ITBItems, Intf) then
    Result := Intf.GetItems
  else
    Result := nil;
end;

{######################################################################
 Procedure/function interface (non OOP)
 ######################################################################
}

{ Sets the "Images" Property of *ALL* toolbar items to the one
  specified as parameter. }
procedure TBFixImageList(Items: TTBCustomItem; Images: TCustomImageList);
var Index: Integer;
    Item: TTBCustomItem;
begin
  for Index := Items.Count - 1 downto 0 do begin
    Item := Items.Items[Index];
    Item.Images := Images;
    if tbisSubmenu in TTBItemAccess(Item).ItemStyle then
      TBFixImageList(Item, Images);
  end;
end;

{ Free all memory associated with the given list of UnmergeItems.
}
procedure TBFreeUnmergeItems(List: PTBUnmergeItem);
var Head: PTBUnmergeItem;
begin
  while List <> nil do
  begin
    Head := List;
    List := Head^.Next;
    Dispose(Head);
  end;
end;

{ Unmerge the subitems of target and source, using the given list of
  UnmergeItems. Doing this the list will be freed.
}
procedure TBUnmergeItems(Target, Source: TTBCustomItem; List: PTBUnmergeItem);
var Op: PTBUnmergeItem;
begin
  BeginUpdateItem(Target);
  try
    BeginUpdateItem(Source);
    try
      try
        while List <> nil do
        begin
          Op := List;
          List := Op^.Next;

          Op^.Item.Parent.Remove(Op^.Item);
          Op^.Parent.Insert(Op^.ParentIndex, Op^.Item);

          Dispose(Op);
        end;
      except
        TBFreeUnmergeItems(List);
        raise;
      end;
    finally
      EndUpdateItem(Source);
    end;
  finally
    EndUpdateItem(Target);
  end;
end;

{ Merge the subitems of target and source, using the given options. The return
  value is a list of "unmerge" UnmergeItems that will revert all modifications.
}
function TBMergeItems(Target, Source: TTBCustomItem; Options: TTBMergeOptions): PTBUnmergeItem;
var List: PTBUnmergeItem;

  { Find the end of the group of items from "Items" starting at index "Start".
    Upon exit, the parameter "Stop" is set to the index of the first item
    *AFTER* the found group and "Group" to the found "GroupIndex".

    If "Start" points to a valid item in the list, the value of "Group" is
    "Items.Items[Start].GroupIndex" and "Stop" is at least "Start+1".

    If "Start" points beyond the list, "Stop" is set equal to "Start".
  }
  procedure FindEndOfGroup(Items: TTBCustomItem; var Start: Integer; out Stop, Group: Integer);
  begin
    { Modified, because seperator items belong to the items following them
      and not preceding them. Otherwise you will not be able to add things
      to the end of a GroupIndex group, because the following separator
      always has a groupindex of 0.

    if Start < Items.Count then
    begin
      Group := Items.Items[Start].GroupIndex;
      Stop := Start + 1;
      while (Stop < Items.Count) and (Items.Items[Stop].GroupIndex <= Group) do
        inc(Stop);
    end
    else
    begin
      Group := 0;
      Stop := Start;
    end;
    }

    // First skip over all seperator items, i.e., find the "real" start
    Stop := Start;
    while (Stop < Items.Count) and
          (tbisSeparator in TTBItemAccess(Items.Items[Stop]).ItemStyle) do
      inc(Stop);

    if Stop = Items.Count then
      Group := 0
    else
    begin
      // We found the first item with a real group index
      Group := Items.Items[Stop].GroupIndex;
      inc(Stop);

      // Now collect all items having at least this group index
      while (Stop < Items.Count) and (Items.Items[Stop].GroupIndex <= Group) do
        inc(Stop);

      // If we did not reach the end, remove all trailing seperator items
      if Stop < Items.Count then
        while (Stop > Start) and
              (tbisSeparator in TTBItemAccess(Items.Items[Stop - 1]).ItemStyle) do
          dec(Stop);
    end;
  end;

  { Move one item from OldParent.Items[OldIndex] to its new position at
    NewParent.Items[NewIndex] and store the corresponding "unmerge"
    operation in our List. Returns true upon successful completion.
  }
  function MoveItem(OldParent: TTBCustomItem; OldIndex: Integer;
                    NewParent: TTBCustomItem; NewIndex: Integer): Boolean;
  var Op: PTBUnmergeItem;
  begin
    Result := (OldIndex >= 0) and (OldIndex < OldParent.Count) and
              (NewIndex >= 0) and (NewIndex <= NewParent.Count);
    if Result then
    begin
      New(Op);
      try
        Op^.Next := List;
        Op^.Item := OldParent.Items[OldIndex];
        Op^.Parent := OldParent;
        Op^.ParentIndex := OldIndex;

        OldParent.Delete(OldIndex);

        try
          NewParent.Insert(NewIndex, Op^.Item);
        except
          OldParent.Insert(OldIndex, Op^.Item);
          raise;
        end;

        List := Op;
      except
        Dispose(Op);
        raise;
      end;
    end;
  end;

  { Move all items between SrcStart and SrcStop (excluding) to the target
    side, adjusting the index parameters accordingly.
  }
  procedure MoveItems(TgtItems: TTBCustomItem; var TgtStart, TgtStop: Integer;
                      SrcItems: TTBCustomItem; var SrcStart, SrcStop: Integer);
  begin
    while (SrcStart < SrcStop) and
          MoveItem(SrcItems, SrcStart, TgtItems, TgtStart) do
    begin
      dec(SrcStop);
      inc(TgtStart);
      inc(TgtStop);
    end;
  end;

  { Returns the string used to identify a matching item.
  }
  function GetItemIdent(Item: TTBCustomItem): string;
  begin
    if moMatchByCaption in Options then
      Result := StripHotkey(Item.Caption)
    else if moMatchByTag in Options then
      Result := IntToStr(Item.Tag)
    else
      Result := Item.Name;
  end;

  { Look for a matching item for "Find" in the given range of items.
  }
  function FindMatchingItem(Items: TTBCustomItem; Start, Stop: Integer;
                            Find: TTBCustomItem): Integer;
  var LookFor: string;
  begin
    LookFor := GetItemIdent(Find);

    Result := -1;

    while (Start < Stop) and (Result < 0) do
    begin
      if CompareText(LookFor, GetItemIdent(Items.Items[Start])) = 0 then
        Result := Start;

      inc(Start);
    end;
  end;

  { Merge the subitems of TgtItems (the target) and SrcItems (the source)
  }
  procedure MergeItems(TgtItems, SrcItems: TTBCustomItem);
  var TgtStart, TgtStop, TgtGroup, SrcStart, SrcStop, SrcGroup, Match: Integer;
  begin
    TgtStart := 0;
    FindEndOfGroup(TgtItems, TgtStart, TgtStop, TgtGroup);

    SrcStart := 0;
    FindEndOfGroup(SrcItems, SrcStart, SrcStop, SrcGroup);

    while (TgtStart < TgtStop) and (SrcStart < SrcStop) do
    begin
      if TgtGroup < SrcGroup then
        // Target block's "GroupIndex" is less than the source block's, the
        // target block of items will be kept (no modification).
        TgtStart := TgtStop
      else if SrcGroup < TgtGroup then
        // Source block's "GroupIndex" is less than the target block's, the
        // source block will be inserted completely.
        MoveItems(TgtItems, TgtStart, TgtStop, SrcItems, SrcStart, SrcStop)
      else
      begin
        if moKeepTarget in Options then
        begin
          // Add new entries from source to target and replace them resp.
          // merge the subitems of matching ones.
          while TgtStart < TgtStop do
          begin
            // Find match for the next item on the target side
            Match := FindMatchingItem(SrcItems, SrcStart, SrcStop, TgtItems.Items[TgtStart]);
            if Match >= 0 then
            begin
              if (moRecursive in Options) and
                 (tbisSubmenu in TTBItemAccess(SrcItems.Items[SrcStart]).ItemStyle) and
                 (tbisSubmenu in TTBItemAccess(TgtItems.Items[TgtStart]).ItemStyle) then
                // Recurse into both lists of subitems
                MergeItems(TgtItems.Items[TgtStart], SrcItems.Items[SrcStart])
              else
              begin
                // Exchange the item and the match
                MoveItem(SrcItems, Match, TgtItems, TgtStart);
                MoveItem(TgtItems, TgtStart + 1, SrcItems, SrcStart);
              end;

              inc(SrcStart);
            end;
            inc(TgtStart);
          end;
        end;

        // Replace target with source, i.e. move target to source side
        // and vice versa. For MMO_MERGE_ADD and MMO_MERGE_RECURSE, the
        // target side is already empty (TgtStart = TgtStop) and the
        // remainder of the source side must be copied completely.
        MoveItems(SrcItems, SrcStart, SrcStop, TgtItems, TgtStart, TgtStop);
        MoveItems(TgtItems, TgtStart, TgtStop, SrcItems, SrcStart, SrcStop);
      end;

      if TgtStart >= TgtStop then
        // Find next group on target side
        FindEndOfGroup(TgtItems, TgtStart, TgtStop, TgtGroup);

      if SrcStart >= SrcStop then
        // Find next group on source side
        FindEndOfGroup(SrcItems, SrcStart, SrcStop, SrcGroup);
    end;

    // Either the target or the source side reached its end. Just copy
    // the remainding source items over to the target side.
    MoveItems(TgtItems, TgtStart, TgtStop, SrcItems, SrcStart, SrcStop);
  end;

begin
  BeginUpdateItem(Target);
  try
    BeginUpdateItem(Source);
    try
      List := nil;
      try
        if moRecursive in Options then
          include(Options, moKeepTarget);

        MergeItems(Target, Source);
      except
        TBUnmergeItems(Target, Source, List);
        raise;
      end;
    finally
      EndUpdateItem(Source);
    end;
  finally
    EndUpdateItem(Target);
  end;

  Result := List;
end;

{######################################################################
 TTBMergedItems
 ######################################################################
}

constructor TTBMergedItems.Create(ATarget, ASource: TTBCustomItem; Options: TTBMergeOptions);
begin
  inherited Create;

  FTarget := ATarget;
  FSource := ASource;
  FOptions := Options;
  FUnmergeItems := nil;

  Merge;
end;

destructor TTBMergedItems.Destroy;
begin
  Unmerge;

  inherited;
end;

procedure TTBMergedItems.Merge;
begin
  if FUnmergeItems = nil then
    FUnmergeItems := TBMergeItems(FTarget, FSource, FOptions);
end;

procedure TTBMergedItems.Unmerge;
var List: PTBUnmergeItem;
begin
  if FUnmergeItems <> nil then
  begin
    List := FUnmergeItems;
    FUnmergeItems := nil;
    TBUnmergeItems(FTarget, FSource, List);
  end;
end;

procedure TTBMergedItems.Dispose;
var List: PTBUnmergeItem;
begin
  if FUnmergeItems <> nil then
  begin
    List := FUnmergeItems;
    FUnmergeItems := nil;
    TBFreeUnmergeItems(List);
  end;
end;

{######################################################################
 TTBToolbarMerger
 ######################################################################
}

constructor TTBToolbarMerger.Create(AOwner: TComponent);
begin
  inherited;

  FMergedItems := TList.Create;
  FPatchOnFree := nil;
end;

destructor TTBToolbarMerger.Destroy;
begin
  if FPatchOnFree <> nil then
    FPatchOnFree^ := 0;

  Clear;
  FreeAndNil(FMergedItems);

  inherited;
end;

procedure TTBToolbarMerger.PatchOnFree(Ptr: Pointer);
begin
  FPatchOnFree := Ptr;
end;

procedure TTBToolbarMerger.Notification(AComponent: TComponent; Operation: TOperation);
var Index: Integer;
    OldItem: TTBMergedItems;

  procedure GiveWarning;
  var s: string;

    function ObjName(Obj: TComponent): string;
    begin
      if Obj = nil then
        Result := 'nil'
      else if Obj.Name <> '' then
        Result := Obj.Name
      else
        Result := Obj.ClassName + Format('(%p)', [Pointer(Obj)]);
    end;

    function ObjFullName(Obj: TComponent): string;
    begin
      if Obj.Owner = nil
        then Result := ObjName(Obj)
        else Result := ObjName(Obj.Owner) + '.' + ObjName(Obj);
    end;

  begin
    s := ObjFullName(Self) + ':'#13#10#13#10 +
         'Component ' + ObjFullName(AComponent) + ' destroyed with'#13#10;

    if AComponent = OldItem.SourceComponent
      then s := s + 'OldItem still merged into ' + ObjFullName(OldItem.TargetComponent) + '.'
      else s := s + 'OldItem still merged from ' + ObjFullName(OldItem.SourceComponent) + '.';

    if OldItem.SourceComponent.Owner is TCustomForm then
      s := s + #13#10#13#10 +
           'You probably forgot to unmerge them in your'#13#10 +
           ObjName(OldItem.SourceComponent.Owner) + '.FormDestroy event.';

    Windows.MessageBox(0, PChar(s), PChar('WARNING'),
      MB_OK or MB_ICONWARNING or MB_SERVICE_NOTIFICATION);
  end;

begin
  inherited;

  if Operation = opRemove then
  begin
    for Index := Count - 1 downto 0 do
    begin
      OldItem := Items[Index];
      if (AComponent = OldItem.TargetComponent) or
         (AComponent = OldItem.SourceComponent) then
      begin
        if (not (csDestroying in OldItem.TargetComponent.ComponentState)) or
           (not (csDestroying in OldItem.SourceComponent.ComponentState)) then
          // At least one of both is not being destroyed
          GiveWarning;

        // Throw away all information, it's too late to do anything.
        // opRemove is sent *AFTER* all sub-components have been marked
        // for deletion, no good idea to unmerge the OldItem here.
        OldItem.Dispose;
        Delete(Index);
      end;
    end;
  end;
end;

function TTBToolbarMerger.GetCount: Integer;
begin
  Result := FMergedItems.Count;
end;

function TTBToolbarMerger.GetItem(Index: Integer): TTBMergedItems;
begin
  Result := TTBMergedItems(FMergedItems[Index]);
end;

function TTBToolbarMerger.IsMerged(Target: TComponent): Integer;
var Root: TTBCustomItem;
begin
  Root := GetComponentItems(Target);

  if Assigned(Root) then
  begin
    Result := Count - 1;
    while (Result >= 0) and (Items[Result].Target <> Root) do
      dec(Result);
  end
  else
    Result := -1;
end;

function TTBToolbarMerger.IsMergedWith(Source: TComponent): Integer;
var Root: TTBCustomItem;
begin
  Root := GetComponentItems(Source);

  if Assigned(Root) then
  begin
    Result := Count - 1;
    while (Result >= 0) and (Items[Result].Source <> Root) do
      dec(Result);
  end
  else
    Result := -1;
end;

procedure TTBToolbarMerger.Merge(Target, Source: TComponent; Options: TTBMergeOptions);
var TargetRoot, SourceRoot: TTBCustomItem;
    NewItem: TTBMergedItems;
    TargetIndex, SourceIndex: Integer;
begin
  // Simply ignore merging anything if the application is about to
  // terminate anyway.
  if Application.Terminated then exit;

  // Get the target root item
  TargetRoot := GetComponentItems(Target);
  Assert(Assigned(TargetRoot), 'TTBToolbarMerger.Merge: Target is not an item container');
  if not Assigned(TargetRoot) then exit;
  if csDestroying in Target.ComponentState then exit;

  // Get the source root item
  SourceRoot := GetComponentItems(Source);
  Assert(Assigned(SourceRoot), 'TTBToolbarMerger.Merge: Source is not an item container');
  if not Assigned(SourceRoot) then exit;
  if csDestroying in Source.ComponentState then exit;

  // Same???
  if TargetRoot = SourceRoot then exit;

  // Check if source is target of another operation
  if IsMerged(SourceRoot) >= 0 then
    raise Exception.Create('TTBToolbarMerger.Merge: Source is target of another merge operation');

  // Check if target is source of another operation
  if IsMergedWith(TargetRoot) >= 0 then
    raise Exception.Create('TTBToolbarMerger.Merge: Target is source of another merge operation');

  // If source is already source of another operation, unmerge that operation
  SourceIndex := IsMergedWith(SourceRoot);
  if SourceIndex >= 0 then
    Delete(SourceIndex);

  // If target is already target of another operation, unmerge that operation
  TargetIndex := IsMerged(TargetRoot);
  if TargetIndex >= 0 then
    Delete(TargetIndex);

  // Merge the NewItem
  NewItem := TTBMergedItems.Create(TargetRoot, SourceRoot, Options);

  if NewItem.UnmergeItems = nil then
    // Nothing done, no need to store it
    FreeAndNil(NewItem)
  else
  begin
    // Remember the components
    NewItem.TargetComponent := Target;
    NewItem.SourceComponent := Source;

    // Ask for notifications
    Target.FreeNotification(Self);
    Source.FreeNotification(Self);

    // Add it to the list
    FMergedItems.Add(NewItem);
  end;
end;

procedure TTBToolbarMerger.Delete(Index: Integer);
var OldItem: TTBMergedItems;
begin
  // Extract item from the list
  OldItem := Items[Index];
  FMergedItems.Delete(Index);

  // Remove the notifications we have set
  OldItem.TargetComponent.RemoveFreeNotification(Self);
  OldItem.SourceComponent.RemoveFreeNotification(Self);

  // Forget it if we are already terminating
  if Application.Terminated then
    OldItem.Dispose;

  // This will also unmerge the item
  FreeAndNil(OldItem);
end;

procedure TTBToolbarMerger.Unmerge(Target, Source: TComponent);
var TargetRoot, SourceRoot: TTBCustomItem;
    Index: Integer;
begin
  // Get the root items
  TargetRoot := GetComponentItems(Target);
  SourceRoot := GetComponentItems(Source);

  // Step through all unmerge bags
  for Index := Count - 1 downto 0 do
    if ((not Assigned(Target)) or (Items[Index].Target = TargetRoot)) and
       ((not Assigned(Source)) or (Items[Index].Source = SourceRoot)) then
      Delete(Index);
end;

procedure TTBToolbarMerger.UnmergeAll(Comp: TComponent);
begin
  if Assigned(Comp) then
  begin
    Unmerge(Comp, nil);
    Unmerge(nil, Comp);
  end;
end;

procedure TTBToolbarMerger.Clear;
begin
  Unmerge(nil, nil);
end;

{######################################################################
 ToolbarMerger
 ######################################################################
}

var
  GlobalToolbarMerger: TTBToolbarMerger;

function ToolbarMerger: TTBToolbarMerger;
begin
  if not Assigned(GlobalToolbarMerger) then
  begin
    GlobalToolbarMerger := TTBToolbarMerger.Create(Application);
    GlobalToolbarMerger.PatchOnFree(@GlobalToolbarMerger);
  end;

  Result := GlobalToolbarMerger;
end;

end.