Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > дубликат TMenuItem

Автор: Vit 6.2.2005, 06:06

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

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

Автор: Pakshin A. S. 6.2.2005, 11:07

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

Код


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

Но Parent - readonly

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

Автор: Pakshin A. S. 6.2.2005, 11:46

Итак, часть проблемы решена:
Изменил 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.

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

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

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

Код


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

Автор: Alex 6.2.2005, 13:49

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

Код


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;

Автор: Alex 6.2.2005, 13:54

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

Автор: Sharl 6.2.2005, 15:00

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

Destination.Assign(Source); ???

Автор: Vit 6.2.2005, 15:07

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

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

Destination.Assign(Source); ???

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

Автор: Alex 6.2.2005, 16:41

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

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

Destination.Assign(Source); ???

Ну попробуй smile

Автор: Sharl 6.2.2005, 20: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;

Автор: Pakshin A. S. 6.2.2005, 20:14

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

Автор: Guest 8.2.2005, 13:11

Цитата

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

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

Автор: Pakshin A. S. 8.2.2005, 21:18

А вот гость и не прав!!!
Эта ошибка вылетает только тогда, когда в процедуре Insert FParent не равно nil... что я собственно и подправил... smile

Вооще-то, мой исковерканный стандартный можуль вроде хорошо дублирует менюшки... вроде все работает... только есть небольшие проблемы при закрытии (см. выше)
Кстати, никому эта идея не понравилась, ибо нет скачиваний... smile

Автор: Vit 9.2.2005, 07:19

Цитата(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;

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

Автор: Alex 24.6.2005, 04:35

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