unit uMenuUtils; interface uses Controls, Forms, ImgList, ActnList, JvPageList, JvNavigationPane, Menus; procedure MergeMenus(Source, Dest: TMainMenu; ImageIndex : Integer = -1); procedure SortMenuByTag(Menu : TMainMenu); function CreatePageNavPane(const APageList : TJvCustomPageList; ACaption : String; AAction : TAction; AImageIndex : Integer): Integer; procedure PopulateNavPagePane(APanePage : TJvNavPanelPage; AMenuItem: TMenuItem; AImageList : TCustomImageList; AStyleManager : TJvNavPaneStyleManager); overload; procedure PopulateNavPagePane(AParentControl : TWinControl; AMenuItem: TMenuItem; AImageList : TCustomImageList; AStyleManager : TJvNavPaneStyleManager); overload; function getSubMenu(Const pMenu: TMainMenu; Const pCaption: String): TMenuItem; procedure copiarItemsMenu(MenuDestino: TMenuItem; pMenu: TMenuItem); implementation uses ComCtrls, Classes, Math, TBXDkPanels, StrUtils, SysUtils, ExtCtrls; 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 := 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 CreatePageNavPane(const APageList : TJvCustomPageList; ACaption : String; AAction : TAction; AImageIndex : Integer): Integer; var APanePage: TJvNavPanelPage; begin Result := 0; APanePage := TJvNavPanelPage.Create(Application); with APanePage do begin Caption := StringReplace(ACaption, '&', '', []); Action := AAction; PageList := APageList; Iconic := False; ImageIndex := AImageIndex; Result := PageIndex; end; end; procedure PopulateNavPagePane(APanePage : TJvNavPanelPage; AMenuItem: TMenuItem; AImageList : TCustomImageList; AStyleManager : TJvNavPaneStyleManager); var APanel : TScrollBox; ItemIndex : Integer; begin with TJvNavPanelDivider.Create(Application) do begin Parent := APanePage; Caption := 'Accesos directos'; ParentStyleManager := True; Align := alTop; end; APanel := TScrollBox.Create(Application); with APanel do begin BevelEdges := []; BorderStyle := bsNone; Parent := APanePage; ParentColor := True; ParentFont := True; Align := alClient; end; for ItemIndex := 0 to (AMenuItem.Count - 1) do begin if AMenuItem[ItemIndex].Caption <> '-' then with TJvNavPanelButton.Create(Application) do begin Parent := APanel; Align := alTop; Tag := AMenuItem[ItemIndex].Tag; Caption := AMenuItem[ItemIndex].Caption; Action := AMenuItem[ItemIndex].Action; Images := AImageList; ImageIndex := AMenuItem[ItemIndex].ImageIndex; Height := 32; StyleManager := AStyleManager; Invalidate; end; end; end; function getSubMenu(const pMenu: TMainMenu; const pCaption: String): TMenuItem; var i: Integer; begin i:=0; while ((i < pMenu.Items.Count) and (StringReplace(pMenu.Items[i].Caption,'&','',[]) <> pCaption)) do inc(i); Result := pMenu.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; procedure PopulateNavPagePane(AParentControl : TWinControl; AMenuItem: TMenuItem; AImageList : TCustomImageList; AStyleManager : TJvNavPaneStyleManager); var ItemIndex : Integer; AHeight : Integer; begin AHeight := 0; for ItemIndex := 0 to (AMenuItem.Count - 1) do begin if AMenuItem[ItemIndex].Caption <> '-' then with TTBXLink.Create(Application) do begin Parent := AParentControl;//APanel; Align := alTop; ParentFont := True; Tag := AMenuItem[ItemIndex].Tag; Caption := AMenuItem[ItemIndex].Caption; Action := AMenuItem[ItemIndex].Action; Images := AImageList; ImageIndex := AMenuItem[ItemIndex].ImageIndex; if ItemIndex = 0 then Margins.Top := 15 else Margins.Top := 8; Margins.Bottom := 8; Margins.Left := 10; Margins.Right := 10; Height := 18; Invalidate; AHeight := AHeight + Margins.Top + Margins.Bottom + Height; end; end; AParentControl.Height := AHeight; AParentControl.Invalidate; end; end.