Tecsitel_FactuGES2/Source/Cliente/Utiles/uMenuUtils.pas

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 := 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.