Реализация TPopupMenu

marvel

Здравствуйте, пытаюсь сделать реализацию TPopupMenu, но у меня никак не получается...
Вроде бы все делаю правильно. Добавляю классы TMenuItem, TPopupMenu. Описываю необходимые методы, например, Add; Свойства...

Но никак не могу заставить работать... При выполнении строки скрипта PopupMenu.Items.Add(MenuItem)... в обработчике CallMethod параметр Instance = NIL (!), MethodName = 'ADD'. Почему так? Я что-то не так делаю? Может я что-то с AddDefaultProperty и AddIndexProperty делаю не так?..

Помогите разобраться...

marvel

может мне привести пример как я это делал?
вот примерно так...

   with AddClass(TMenuItem, 'TComponent') do
    begin
     AddMethod('procedure Add(Item: TMenuItem)', CallMethod);
     AddMethod('procedure Clear', CallMethod);
     AddMethod('procedure Delete(Index: Integer)', CallMethod);
     AddMethod('procedure Insert(Index: Integer; Item: TMenuItem)', CallMethod);
     AddMethod('procedure Remove(Item: TMenuItem)', CallMethod);
     AddEvent('OnClick', TfsNotifyEvent);
     AddProperty('Count', 'Integer', GetProp);
     AddIndexProperty('Items', 'Integer', 'TMenuItem', CallMethod, False);
    end;
    with AddClass(TPopupMenu, 'TComponent') do
    begin
     AddMethod('procedure Popup(X, Y: Integer)', CallMethod);
     AddEvent('OnPopup', TfsNotifyEvent);
     AddDefaultProperty('Items', 'Integer', 'TMenuItem', CallMethod, False);
    end;  

Но.. увы, не работает...

awex

А реализация CallMethod какая???

marvel

awex написал:

А реализация CallMethod какая???

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
var
  APopuMenu: TPopupMenu;
  AMenuItem:TMenuItem;
begin
  Result := 0;

  if ClassType = TMenuItem then
   begin
    AMenuItem := TMenuItem(Instance);
    if MethodName = 'ADD' then
     AMenuItem.Add(TMenuItem(Integer(Caller.Params[0])))
    else if MethodName = 'CLEAR' then
     AMenuItem.Clear
    else if MethodName = 'DELETE' then
     AMenuItem.Delete(Caller.Params[0])
    else if MethodName = 'INSERT' then
     AMenuItem.Insert(Caller.Params[0], TMenuItem(Integer(Caller.Params[1])))
    else if MethodName = 'REMOVE' then
     AMenuItem.Remove(TMenuItem(Integer(Caller.Params[0])))
    else if MethodName = 'ITEMS.GET' then
      Result := Integer(AMenuItem.Items[Caller.Params[0]]);
   end;

  if ClassType = TPopupMenu then
  begin
    APopuMenu := TPopupMenu(Instance);
    if MethodName = 'POPUP' then
      APopuMenu.Popup(Caller.Params[0], Caller.Params[1]);
  end;
end;  

Да я уж всяко пробовал и не только так...

awex

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

Pascal Script:

procedure Button1Click(Sender: TObject);
var
  item: TMenuItem;
begin
  item := TMenuItem.Create(Form);
  Item.Caption := 'eee';
  PopupMenu1.Items.Add(Item);
  PopupMenu1.Items[0].Caption :='Hello';
  PopupMenu1.Popup(100, 100);
end;

Source:

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  with AScript do
  begin
    with AddClass(TMenuItem, 'TComponent') do
    begin
      AddMethod('procedure Add(Item: TMenuItem)', CallMethod);
      AddMethod('procedure Clear', CallMethod);
      AddMethod('procedure Delete(Index: Integer)', CallMethod);
      AddMethod('procedure Insert(Index: Integer; Item: TMenuItem)', CallMethod);
      AddMethod('procedure Remove(Item: TMenuItem)', CallMethod);
      AddEvent('OnClick', TfsNotifyEvent);
      AddProperty('Count', 'Integer', GetProp);
      AddDefaultProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
    end;
    with AddClass(TMenu, 'TComponent') do
    begin
      AddIndexProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
    end;
    with AddClass(TPopupMenu, 'TMenu') do
    begin
      AddEvent('OnPopup', TfsNotifyEvent);
      AddMethod('procedure Popup(X, Y: Integer)', CallMethod);
    end; 
  end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: string; Caller: TfsMethodHelper): Variant;
var
  AMenuItem: TMenuItem;
begin
  Result := 0;
  if ClassType = TMenuItem then
  begin
    AMenuItem := TMenuItem(Instance);
    if MethodName = 'ADD' then
      AMenuItem.Add(TMenuItem(Integer(Caller.Params[0])))
    else if MethodName = 'CLEAR' then
      AMenuItem.Clear
    else if MethodName = 'DELETE' then
      AMenuItem.Delete(Caller.Params[0])
    else if MethodName = 'INSERT' then
      AMenuItem.Insert(Caller.Params[0], TMenuItem(Integer(Caller.Params[1])))
    else if MethodName = 'REMOVE' then
      AMenuItem.Remove(TMenuItem(Integer(Caller.Params[0])))
    else if MethodName = 'ITEMS.GET' then
      Result := Integer(AMenuItem.Items[Caller.Params[0]]);
  end
  else if ClassType = TMenu then
  begin
    if MethodName = 'ITEMS.GET' then
      Result := Integer(TMenu(Instance).Items[Caller.Params[0]])
  end
  else if ClassType = TPopupMenu then
  begin
    if MethodName = 'POPUP' then
      TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
  end;
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: string): Variant;
begin
  Result := 0;
  if ClassType = TMenuItem then
  begin
    if PropName = 'COUNT' then
      Result := TMenuItem(Instance).Count;
  end;
end;

P:S:
кода пишешь файлы импорта нужно быть очень внимательным.. )))

marvel

Спасибо большое!