Есть меню, в нём есть пункт (типа TMenuItem естественно), надо в другом меню создать точно такой же пункт со такими же свойствами (Caption, tag, onClick и т.д.). По ряду причин в данном конкретном случае Action воспользоваться не получится... Есть способ это сделать как-то быстрее чем тупое приравнивание двух десятков свойств?


PS. Уже когда писал топик понял, что скорее всего нет из-за свойства Shortcut которое вроде как логично должно быть уникальным, хотя я его как раз и не использую... Тем ни менее... может у кого есть какие мысли.

Теоритически можно так:

Код

var MenuI: TMenuItem; begin MenuI:=ShowMes1; MenuI.Parent:=nil; // но это зепрещено.... N21.Insert(0, MenuI);

Но Parent - readonly

Все получается только при удалении пункта ShowMes1

Итак, часть проблемы решена:
Изменил Menus.pas:

Код

procedure TMenuItem.Insert(Index: Integer; Item: TMenuItem); begin {Здесь}  if Item.FParent <> nil then Item.FParent:=nil;  if FItems = nil then FItems := TList.Create;  if (Index - 1 >= 0) and (Index - 1 < FItems.Count) then    if Item.GroupIndex < TMenuItem(FItems[Index - 1]).GroupIndex then      Item.GroupIndex := TMenuItem(FItems[Index - 1]).GroupIndex;  VerifyGroupIndex(Index, Item.GroupIndex);  FItems.Insert(Index, Item);  Item.FParent := Self;  Item.FOnChange := SubItemChanged;  if FHandle <> 0 then RebuildHandle;  MenuChanged(Count = 1); end;

Теперь со спокойной совестью можно написать вот такое:

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, Menus; type  TForm1 = class(TForm)    MainMenu1: TMainMenu;    N11: TMenuItem;    N21: TMenuItem;    ShowMes1: TMenuItem;    Button1: TButton;    procedure ShowMes1Click(Sender: TObject);    procedure Button1Click(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} procedure TForm1.ShowMes1Click(Sender: TObject); begin ShowMessage('asdf') end; procedure TForm1.Button1Click(Sender: TObject); begin N21.Insert(0, ShowMes1); // !!! end; end.

Вроде работает... особо времени тестить не было...

Теперь появилась другая проблема: При закрытии проги вылетает ошибка... как избежать пока не понял...

Прикрепляю dcu "испорченного" модуля:
Добавлено @ 11:54
Чтобы избежать ошибки при выходе из программы, нам надо удалить "братьев-близнецов":

Код

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin N21.Delete(0); N11.Delete(0); end;

Присоединённый файл ( Кол-во скачиваний: 1 )
 Menus.dcu

А вот, что вышло у меня:

Код

procedure CopyComponentProp(Source: TObject; Receiver: TObject; aExcept: array of string); // Копирование всех одинаковых по названию свойств/методов одного компонента в // другой за исключение "Name", "Left", "Top" и тех которые заданы в aExcept var  I: Integer;  Props: PPropList;  TypeData: PTypeData; begin  if (Source = nil) or (Source.ClassInfo = nil) then Exit;  TypeData := GetTypeData(Source.ClassInfo);  if (TypeData = nil) or (TypeData^.PropCount = 0) then Exit;  GetMem(Props, TypeData^.PropCount * sizeof(Pointer));  try    GetPropInfos(Source.ClassInfo, Props);    for I := 0 to TypeData^.PropCount-1 do begin      with Props^[I]^ do begin        if (AnsiIndexText(Name, ['Name', 'Left', 'Top']) =  -1 ) and           (AnsiIndexText(Name, aExcept                ) =  -1 ) and           (GetPropInfo  (Receiver.ClassInfo, Name     ) <> nil) then try          case PropType^^.Kind of            tkInteger, tkChar,            tkEnumeration, tkFloat,            tkString, tkSet, tkWChar,            tkLString, tkWString,            tkVariant, tkArray,            tkRecord, tkInterface,            tkInt64, tkDynArray:   SetPropValue (Receiver, Name, GetPropValue (Source, Name));            tkMethod:              SetMethodProp(Receiver, Name, GetMethodProp(Source, Name));            tkClass:               SetOrdProp   (Receiver, Name, GetOrdProp   (Source, Name));          end;        except          raise Exception.CreateFmt('Произошла ошибка при копировании свойства/метода "%s" тип "%d".', [Name, Integer(PropType^^.Kind)]);        end;      end;    end;  finally    FreeMem(Props);  end; end;

Пример использования:

Присоединённый файл ( Кол-во скачиваний: 7 )
 CopyComponentProp.rar

А если использовать

Destination.Assign(Source); ???

Цитата(Sharl @ 6.2.2005, 06:00)

А если использовать Destination.Assign(Source); ???

А если попробовать?

Цитата(Sharl @ 6.2.2005, 15:00)

А если использовать Destination.Assign(Source); ???

Ну попробуй

Цитата

Ну попробуй

Ой всего лишь

Код

procedure TMenuItem.AssignTo(Dest: TPersistent); begin  if Dest is TCustomAction then    with TCustomAction(Dest) do    begin      Enabled := Self.Enabled;      HelpContext := Self.HelpContext;      Hint := Self.Hint;      ImageIndex := Self.ImageIndex;      Caption := Self.Caption;      Visible := Self.Visible;      OnExecute := Self.OnClick;    end  else inherited AssignTo(Dest); end;

Вот об этом и говорил Vit, что приходится перебирать свойства...

Цитата

нет из-за свойства Shortcut которое вроде как логично должно быть уникальным

прежде всего логично, что уникальным должен быть HANDLE иначе выскочит ошибка "Menu inserted twice" из чего следует что два ОДИНАКОВЫХ пункта в меню быть не может, только с некоторыми совпадающими свойствами. То есть придется создавать новый пункт меню и копировать необходимые свойства вручную.

А вот гость и не прав!!!
Эта ошибка вылетает только тогда, когда в процедуре Insert FParent не равно nil... что я собственно и подправил...
Вооще-то, мой исковерканный стандартный можуль вроде хорошо дублирует менюшки... вроде все работает... только есть небольшие проблемы при закрытии (см. выше)
Кстати, никому эта идея не понравилась, ибо нет скачиваний...

Цитата(Pakshin @ 8.2.2005, 12:18)

Кстати, никому эта идея не понравилась, ибо нет скачиваний...

Править VCL - это самое крайнее средство, уж лучше перебором...

Цитата(Sharl @ 6.2.2005, 11:10)

Ой  всего лишь Код procedure TMenuItem.AssignTo(Dest: TPersistent); begin if Dest is TCustomAction then   with TCustomAction(Dest) do   begin     Enabled := Self.Enabled;     HelpContext := Self.HelpContext;     Hint := Self.Hint;     ImageIndex := Self.ImageIndex;     Caption := Self.Caption;     Visible := Self.Visible;     OnExecute := Self.OnClick;   end else inherited AssignTo(Dest); end;

А почему вы так уверены что мне только эти свойства и события понадобятся? Там их гораздо больше....

В арсенале доступна обновленная версия процедуры для копирования свойств и методов одного компонента в другой
http://forum.vingrad.ru/index.php?showtopi...ndpost&p=450550