ProGestion/Cliente/uMenuUtils.pas

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.