80分求助DELPHI中莱单A完全遍历复制莱单项到莱单B

Question

求助DELPHI中莱单A完全遍历复制莱单项到莱单B
Tmainmenu的所有莱单项完全复到另一个莱单项中，怎么实现呢？能做到的，一定给分结贴，绝不食言：
现假设有莱单结构是这样的：
MainMenuA:Test                       Best
A1                         B1
A2                         B2  
-  //分隔线                B3->B31-B32 
A3->A30->A301
    A31->A302->A303
               A304莱单层数不限，这个是要进行递归了，要完全遍历ManinMenuA复制莱单项到莱单B
请问怎样实现呢?

Answer 1

完全复制有难度，有些对象属性可能需要自己手动可以通过stream.writeComponent方法 将其流化，可能加载时需要重新非配 方法属性

Answer 2

遍历到就创建新菜单啊var
  NewMenu: TMenuItem;
begin
  NewMenu := TMenuItem.Create(Self);
  NewMenu.Caption := '标题';
  NewMenu.Name := 'ClassName'; // 类名不能有重复
  MainMenu1.Items.Add(NewMenu);
end;还有一些细节处理就OK了，比如事件关联啊，属性啊什么的

Answer 3

PAS:
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, TypInfo, ImgList;type
  TForm1 = class(TForm)
    mm1: TMainMenu;
    MM11: TMenuItem;
    MniITEM: TMenuItem;
    MniITEM21: TMenuItem;
    MniN1: TMenuItem;
    MniITEM31: TMenuItem;
    MniSUBITEM11: TMenuItem;
    MniMM21: TMenuItem;
    MniITEM41: TMenuItem;
    Btn1: TButton;
    il1: TImageList;
    procedure Btn1Click(Sender: TObject);
    procedure MniITEM31Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;  aMiAccess = class(TMenuItem)
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure GetClassProperties(AClass: TClass; AStrings: TStrings);
var
 PropCount, I: SmallInt;
 PropList: PPropList;
 PropStr: string;
begin
 PropCount := GetTypeData(AClass.ClassInfo).PropCount;
 GetPropList(AClass.ClassInfo, PropList);
 for I := 0 to PropCount - 1 do
 begin
  PropStr := PropList[I]^.Name;
  case PropList[I]^.PropType^.Kind of
    tkUnknown: PropStr := PropStr + '=Unknown';
    tkInteger: PropStr := PropStr + '=Integer';
    tkChar: PropStr := PropStr + '=Char';
    tkEnumeration: PropStr := PropStr + '=Enumeration';
    tkFloat: PropStr := PropStr + '=Float';
    tkString: PropStr := PropStr + '=String';
    tkSet: PropStr := PropStr + '=Set';
    tkClass: PropStr := PropStr + '=Class';
    tkMethod: PropStr := PropStr + '=Method';
    tkWChar: PropStr := PropStr + '=WChar';
    tkLString: PropStr := PropStr + '=LString';
    tkWString: PropStr := PropStr + '=WString';
    tkVariant: PropStr := PropStr + '=Variant';
    tkArray: PropStr := PropStr + '=Array';
    tkRecord: PropStr := PropStr + '=Record';
    tkInterface: PropStr := PropStr + '=Interface';
    tkInt64: PropStr := PropStr + '=Int64';
    tkDynArray: PropStr := PropStr + '=DynArray';
  end;
  AStrings.Add(PropStr);
 end;
 FreeMem(PropList);
end;
procedure TForm1.Btn1Click(Sender: TObject);
var
  I: Integer;
  aMainMi: TMenuItem;
  aPList, aMPList: TStrings;
  aMainMu: TMainMenu;
  aFrm: TForm;  procedure CopyProp(sMi,dMi: TObject; aPropList: TStrings);
  var
    j: Integer;
    aVar: Variant;
    aStr: string;
    aWnd: LongInt;
    aMth: TMethod;
  begin
    for j := 0 to aPropList.Count - 1 do
    begin
      try
        aVar := GetPropValue(sMi,aPropList.Names[j],False);
        SetPropValue(dMi,aPropList.Names[j],aVar);
      except
        if aPropList.ValueFromIndex[j] = 'Class' then
        begin
          if aPropList.Names[j] <> 'Items' then
          begin
            aWnd := GetOrdProp(sMi,aPropList.Names[j]);
            SetOrdProp(dMi,aPropList.Names[j],aWnd);
          end;
        end else
        if aPropList.ValueFromIndex[j] = 'Method' then
        begin
          aMth := GetMethodProp(sMi,aPropList.Names[j]);
          SetMethodProp(dMi,aPropList.Names[j],aMth);
        end;
      end;
    end;
  end;  procedure GetItem(sMi: TMenuItem;dMi: TMenuItem; aPropList: TStrings);
  var
    j: Integer;
    aMi,aMi1: TMenuItem;
  begin
    for j:= 0 to sMi.Count - 1 do
    begin
      aMi := sMi.Items[j];
      aMi1 := TMenuItem.Create(aFrm);
      CopyProp(aMi,aMi1,aPropList);
      dMi.Add(aMi1);
      if aMi.Count > 0 then
        GetItem(aMi,aMi1,aPropList);
    end;
  end;begin
  aPList := TStringList.Create;
  aMPList := TStringList.Create;
  aFrm := TForm.Create(Application);
  GetClassProperties(TMenuItem,aPList);
  GetClassProperties(TMainMenu,aMPList);
  aMainMu := TMainMenu.Create(aFrm);
  CopyProp(mm1,aMainMu,aMPList);
  for I := 0 to mm1.Items.Count - 1 do
  begin
    aMainMi := TMenuItem.Create(aFrm);
    CopyProp(mm1.Items[i],aMainMi,aPList);
    aMainMu.Items.Add(aMainMi);
    GetItem(mm1.Items[i],aMainMi,aPList);
  end;
  aFrm.Show;
  FreeAndNil(aPList);
  FreeAndNil(aMPList);
end;procedure TForm1.MniITEM31Click(Sender: TObject);
begin
  ShowMessage(TMenuItem(Sender).Caption);
end;end.dfm因为有imageList，这里放不下，就不放了。。RTTI写的，可以复制包括类、事件。。
现写的，调试花了我好两个多小时了。。不加分我跟你急哈。。

Answer 4

大家辛苦了，不论行不行，我已结了，Ray2312太友好了，谢谢你，也谢谢大家，我这就测试去