Реализация TPopupMenu

Комментарии

• marvel

  June 2006 отредактировано 03:35

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

     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

  June 2006 отредактировано 03:35

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

  June 2006 отредактировано 03:35

  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

  June 2006 отредактировано 03:35

  Вот у меня такой код вполне работоспособен.
  Сравни со своим, как говориться найди отличия.
  
  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

  June 2006 отредактировано 03:35

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