unit uMenuUtils; interface uses Forms, ImgList, ActnList, JvPageList, JvNavigationPane, Menus, Controls; procedure MergeMenus(Source, Dest: TMainMenu; ImageIndex : Integer = -1); procedure SortMenuByTag(Menu : TMainMenu); function BuscarMenu(const AMainMenu: TMainMenu; const ACaption: String): TMenuItem; procedure copiarItemsMenu(MenuDestino: TMenuItem; pMenu: TMenuItem); implementation uses ComCtrls, Classes, Math, TBXDkPanels, StrUtils, SysUtils, ExtCtrls, Graphics, Dialogs; type TAssignCallback = procedure(Source, Dest: TMenuItem); procedure AssignMenus(Source, Dest: TMenuItem; AImageIndex : Integer; AssignProc: TAssignCallback); var I: Integer; Item: TMenuItem; begin for I := 0 to Source.Count - 1 do begin Item := NIL; if Source.Items[I].Caption <> '-' then Item := Dest.Find(Source.Items[I].Caption); if Item = NIL then begin Item := TMenuItem.Create(Dest); Dest.Add(Item); if Assigned(AssignProc) then begin AssignProc(Source.Items[I], Item); if (Source.Items[I].ImageIndex >= 0) then Item.ImageIndex := Source.Items[I].ImageIndex + AImageIndex; end; end; AssignMenus(Source.Items[I], Item, AImageIndex, AssignProc); end; end; procedure AssignMenuItem(Source, Dest: TMenuItem); begin Dest.Caption := Source.Caption; Dest.Hint := Source.Hint; Dest.Checked := Source.Checked; Dest.GroupIndex := Source.GroupIndex; Dest.Tag := Source.Tag; Dest.Action := Source.Action; Dest.ImageIndex := Source.ImageIndex; Dest.ShortCut := Source.ShortCut; Dest.RadioItem := Source.RadioItem; Dest.AutoCheck := Source.AutoCheck; Dest.AutoHotkeys := Source.AutoHotkeys; Dest.AutoLineReduction := Source.AutoLineReduction; Dest.Break := Source.Break; Dest.Default := Source.Default; Dest.Enabled := Source.Enabled; Dest.HelpContext := Source.HelpContext; Dest.Visible := Source.Visible; end; procedure SortMenuItems(MenuItems : TMenuItem); function CompareTags(Item1, Item2: Pointer): Integer; begin Result := CompareValue(TMenuItem(Item1).Tag, TMenuItem(Item2).Tag); end; var I: Integer; AList : TList; begin AList := TList.Create; try for I := 0 to MenuItems.Count - 1 do begin SortMenuItems(MenuItems.Items[i]); AList.Add(Pointer(MenuItems.Items[i])); end; AList.Sort(@CompareTags); for i := 0 to AList.Count - 1 do TMenuItem(AList.Items[i]).MenuIndex := i; finally AList.Free; end; end; procedure MergeMenus(Source, Dest: TMainMenu; ImageIndex : Integer = -1); begin AssignMenus(Source.Items, Dest.Items, ImageIndex, AssignMenuItem); end; procedure SortMenuByTag(Menu : TMainMenu); begin SortMenuItems(Menu.Items); end; function BuscarMenu(const AMainMenu: TMainMenu; const ACaption: String): TMenuItem; var i: Integer; begin i:=0; while ((i < AMainMenu.Items.Count-1) and (StringReplace(AMainMenu.Items[i].Caption,'&','',[]) <> ACaption)) do Inc(i); Result := AMainMenu.Items[i]; end; procedure copiarItemsMenu(MenuDestino, pMenu: TMenuItem); var i: Integer; Item: TMenuItem; begin for i := 0 to (pMenu.Count - 1) do begin Item := TMenuItem.Create(MenuDestino); Item.Caption := pMenu.Items[i].Caption; Item.Action := pMenu.Items[i].Action; MenuDestino.Add(Item); end; end; end.