Конференция "Компоненты" » Создание подменю в редакторе компонента.
 
  • TStas (18.05.12 00:30) [0]
    При написание редакторов компонента при перекрытии GetVerb и GetVerbCount добавляются пункты к стандартному меню. Что можно к пунктам добавлять подпукты, то есть раскрывающие менюшки, это точно. Я как-то это делал, но куда дел пример, забыл совсем :(
    Там, вроде, интерфейсы к TMenuItem предоставлялись, или как-то так.
  • DimaBr © (18.05.12 10:34) [1]
    Давно это было, игрался с картинками в менюшках (D6), потом методику рисования изменили (D7), а потом и совсем убрали D12, D16. Код переписывать было лень. Работу с Action можно выкинуть.

    TBrDefaultEditor = class(TDefaultEditor)
     private
       procedure ActionExecute(Sender: TObject);
     protected
       procedure DesignerModified;
       procedure PrepareMenuItem(Index: Integer; const Item: TMenuItem); virtual;
       procedure GetCaption(Values: TStrings); virtual;
       function CreateMenuItem(ParentItem: TMenuItem; Caption: string; Tag: integer; Checked: boolean; OnClick: TNotifyEvent): TMenuItem;
       function FindAction(AL: TCustomActionList; AName: string): TContainedAction;
       function CreateAction(AName, ACaption, BmpName: string; NumGlyph: integer): TContainedAction;
     public
       function GetVerb(Index: integer): string; override;
       function GetVerbCount: integer; override;
       procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
       constructor Create(AComponent: TComponent; ADesigner: IDesigner); override;
    end;

    { TBrDefaultEditor }

    constructor TBrDefaultEditor.Create(AComponent: TComponent; ADesigner: IDesigner);
    var SL: TStringList;
       i: integer;
    begin
     inherited Create(AComponent,ADesigner);
     SL := TStringList.Create;
     try
       GetCaption(SL);
       for i := 0 to SL.Count -1 do begin
         if Pos('=',SL[i]) = 0 then Continue;
         CreateAction(ClassName+'_'+IntToStr(i),SL.Names[i], SL.Values[SL.Names[i]],1);
       end;
     finally
       SL.Free;
     end;
    end;

    procedure TBrDefaultEditor.PrepareItem(Index: Integer; const AItem: IMenuItem);
    var CompRef: IInterfaceComponentReference;
       A: TContainedAction;
       M: TMenuItem;
       Event: TNotifyEvent;
    begin
     if Supports(AItem,IInterfaceComponentReference,CompRef) then
       if CompRef.GetComponent is TMenuItem then begin
         M := TMenuItem(CompRef.GetComponent);
         if not Assigned(M.Action) and (Index < GetVerbCount) then begin
           A := FindAction(nil,ClassName+'_'+IntToStr(Index));
           if Assigned(A) then begin
             Event := M.OnClick;
             M.Action := A;
             M.OnClick := Event;
           end;
         end;
         PrepareMenuItem(Index, M);
       end;
    end;

    procedure TBrDefaultEditor.ActionExecute(Sender: TObject);
    begin
    end;

    procedure TBrDefaultEditor.DesignerModified;
    begin
     if Designer <> nil then Designer.Modified;
    end;

    procedure TBrDefaultEditor.GetCaption(Values: TStrings);
    begin// virtual
    end;

    function TBrDefaultEditor.CreateMenuItem;
    begin
     Result := TMenuItem.Create(ParentItem);
     Result.Caption := Caption;
     Result.Tag := Tag;
     Result.Checked := Checked;
     Result.OnClick := OnClick;
     ParentItem.Add(Result);
    end;

    function TBrDefaultEditor.FindAction(AL: TCustomActionList; AName: string): TContainedAction;
    var i: integer;
       N: INTAServices;
    begin
     if not Assigned(AL) then begin
       N := NTAServices;
       if Assigned(N) then AL := N.ActionList;
     end;
     if Assigned(AL) then
       for i := 0 to AL.ActionCount -1 do
         if SameText(AL.Actions[i].Name,AName) then begin
           Result := AL.Actions[i];
           Exit;
         end;
     Result := nil;
    end;

    function TBrDefaultEditor.CreateAction;
    var N: INTAServices;
       AL: TCustomActionList;
       AIndex: integer;
       Bmp,Bmp16: TBitMap;
    begin
     Result := nil;
     N := NTAServices;
     if Assigned(N) then AL := N.ActionList else AL := nil;
     if not Assigned(AL) then Exit;
     Result := FindAction(AL,AName);
     if Assigned(Result) then Exit;
     Result := TAction.Create(AL);
     AIndex := -1;
     if FindResource(HInstance,PChar(BmpName), RT_BITMAP)>0 then begin
       Bmp := TBitMap.Create;
       Bmp.LoadFromResourceName(HInstance,BmpName);
       Bmp16 := CreateBitMap(16,16);
       Bmp16.Canvas.CopyRect(Rect(0,0,16,16),Bmp.Canvas,Rect(0,0,Bmp.Width div NumGlyph,Bmp.Height));
       AIndex := N.ImageList.AddMasked(Bmp16,Bmp.Canvas.Pixels[0,Bmp.Height-1]);
       Bmp.Free;
       Bmp16.Free;
     end;
     with TAction(Result) do begin
       ActionList := AL;
       Name := AName;
       Caption := ACaption;
       ImageIndex := AIndex;
       OnExecute := ActionExecute;
     end;
    end;

    function TBrDefaultEditor.GetVerb(Index: integer): string;
    var SL: TStringList;
    begin
     SL := TStringList.Create;
     try
       GetCaption(SL);
       if Index < SL.Count
         then Result := SL[Index]
         else Result := Inherited GetVerb(Index);
     finally
       FreeObj(SL);
     end;
    end;

    function TBrDefaultEditor.GetVerbCount: integer;
    var SL: TStringList;
    begin
     SL := TStringList.Create;
     try
       GetCaption(SL);
       Result := SL.Count;
     finally
       FreeObj(SL);
     end;
    end;

    procedure TBrDefaultEditor.PrepareMenuItem(Index: Integer;const Item: TMenuItem);
    begin
    end;


    И вот редактор для кнопки типа TBitBtn

    TBrBitBtnEditors = class(TBrDefaultEditor)
     protected
       procedure PrepareMenuItem(Index: Integer; const Item: TMenuItem); override;
       procedure KindMenuClick(Sender: TObject);
     public
       procedure GetCaption(Values: TStrings);override;
    end;

    // ------------ TBrBitBtnEditors  ---------------------------

    procedure TBrBitBtnEditors.GetCaption(Values: TStrings);
    begin
     Values.Add('Kind');
    end;

    procedure TBrBitBtnEditors.KindMenuClick(Sender: TObject);
    begin
     TBrBitBtn(Component).Kind := TBrBitBtnKind(TMenuItem(Sender).Tag);
     DesignerModified;
    end;

    procedure TBrBitBtnEditors.PrepareMenuItem(Index: Integer; const Item: TMenuItem);
    var i: TBrBitBtnKind;
       MenuItem: TMenuItem;
       A: TAction;
       S, BName: string;
    begin
     if Index = 0 then
       for i := Low(TBrBitBtnKind) to High(TBrBitBtnKind) do begin
         S := GetEnumName(TypeInfo(TBrBitBtnKind), ord(i));
         BName := BitBtnResNames[i];
         MenuItem := TMenuItem.Create(Item);
         MenuItem.Tag := Ord(i);
         A := CreateAction(ClassName+'_'+S,S,BName,2) as TAction;
         MenuItem.Action := A;
         if not Assigned(A) then MenuItem.Caption := S;
         MenuItem.OnClick := KindMenuClick;
         Item.Add(MenuItem);
       end;
    end;

  • TStas (18.05.12 14:19) [2]
    Спасибо, буду пробовать. А вот про картинки не знал.
  • DimaBr © (18.05.12 15:05) [3]
    Какая версия стоит ???
  • TStas (18.05.12 15:26) [4]
    7-я.
  • TStas (21.05.12 23:25) [5]
    Кстати, сегодня утром всё получилось.
    procedure TStCodeEditorComponentEditor.PrepareItem(Index: Integer;
     const AItem: IMenuItem);
    begin
     inherited;
     Case Index of
       0: ; //'Edit custom shortcuts';
       1: //'Edit bookmarks menu items';
         Begin
         AItem.AddItem('Items "Toggle bookmarks"', 0, False, True,  ToggleItemClick);
         AItem.AddItem('Items "Go to bookmarks"', 0, False, True,  GoToItemClick);
         AItem.AddItem('Items "Show bookmarks"', 0, False, True,  ShowBookmarkItemClick);
         End;
       2: //'Edit built in replacer';
         Begin
         AItem.AddItem('Edit menu items', 0, False, True,  ReplacerMenuItemsClick);
         AItem.AddItem('Edit connected buttons', 0, False, True,  ReplacerButtonsClick);
         End;
       3: //'Edit menu items "Edit"'
         Begin
         AItem.AddItem('Items "Edit"', 0, False, True,  ItemsEditClick);
         AItem.AddItem('Items "Selection protected"', 0, False, True,  ProtectedItemClick);
         End;
     End;
    end;

    Там надо подключать DesignMenus. Ваш код вообще ещё более широкую задачу решает.
    ОФФТОП: >DimaBr Вы мне писали, что такой код:
    procedure TCustomRichEdit.WMNCDestroy(var Message: TWMNCDestroy);
    begin
     inherited;
    end;
    кривой. Он и мне кривым кажется. Но пример, который повесил, взят из ExtCtrls. Дельфи 7. По-другому если делать,  Дельфи гряно ругаются.
 
Конференция "Компоненты" » Создание подменю в редакторе компонента.
Есть новые Нет новых   [103778   +18][b:0][p:0.006]