delphi – 如何使一个CustomComponents检测表单上是否有新组件

这是使用TActionList后代和TCustomActionManager的快速测试：当在设计时在表单上删除TActionListEx组件的实例时,它枚举所有当前项目的模块并尝试查找具有TCustomActionManager实例的表单/数据模块.如果找到一个,它会将新创建的TActionListEx添加到其LinkedActionLists集合中.

运行时包：

unit TestComponents;

interface

uses
  System.Classes,Vcl.ActnList;

type
  TActionListEx = class(TActionList)
  public
    constructor Create(AOwner: TComponent); override;
  end;
  TNotifyProc = procedure(Sender: TObject);

var
  CreateNotify: TNotifyProc = nil;

implementation

{ TActionListEx }

constructor TActionListEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (csDesigning in ComponentState) and Assigned(CreateNotify) then
    CreateNotify(Self);
end;

end.

设计时间包：

unit TestComponentsDesign;

interface

procedure Register;

implementation

uses
  System.Classes,System.SysUtils,Vcl.ActnMan,ToolsAPI,TestComponents;

procedure CreateNotifyProc(Sender: TObject);
var
  ActionList: TActionListEx absolute Sender;
  ModuleServices: IOTAModuleServices;
  ActiveProject: IOTAProject;
  I,J: Integer;
  ModuleInfo: IOTAModuleInfo;
  Module: IOTAModule;
  Editor: IOTAFormEditor;
  RootComponent: IOTAComponent;
  Component: INTAComponent;
  ActionManager: TCustomActionManager;
  ActionListItem: TActionListItem;
begin
  if not (Sender is TActionListEx) or not (csDesigning in ActionList.ComponentState) then
    Exit;

  if not Supports(BorlandIDEServices,IOTAModuleServices,ModuleServices) then
    Exit;

  ActiveProject := ModuleServices.GetActiveProject;
  if not Assigned(ActiveProject) then
    Exit;

  for I := 0 to ActiveProject.GetModuleCount - 1 do
  begin
    Module := nil;
    Editor := nil;
    RootComponent := nil;

    ModuleInfo := ActiveProject.GetModule(I);
    if Assigned(ModuleInfo) and (ModuleInfo.FormName <> '') then
      Module := ModuleInfo.OpenModule;

    if Assigned(Module) then
      for J := 0 to Module.ModuleFileCount - 1 do
        if Supports(Module.ModuleFileEditors[J],IOTAFormEditor,Editor) then
          Break;

    if Assigned(Editor) then
      RootComponent := Editor.GetRootComponent;

    if Assigned(RootComponent) then
      for J := 0 to RootComponent.GetComponentCount - 1 do
        if Supports(RootComponent.GetComponent(J),INTAComponent,Component) and (Component.GetComponent is TCustomActionManager) then
        begin
          ActionManager := TCustomActionManager(Component.GetComponent);
          ActionListItem := ActionManager.LinkedActionLists.Add as TActionListItem;
          try
            ActionListItem.ActionList := ActionList;
            Editor.MarkModified;
            Exit;
          except
            ActionListItem.Free;
            raise;
          end;
        end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Test',[TActionListEx]);
  CreateNotify := CreateNotifyProc;
end;

initialization

finalization
  CreateNotify := nil;

end.