Autoregister attribute for Delphi

Wouldnt it be nice if Delphi had an attribute that would automatically register your classes? So instead of having to manually call Registerclass() you just decorate the class with an attribute and it’s automatically registered. No messing about with rouge procedure calls in the initialize section, just pretty and neat class declarations as far as the eye can see.

Well, I think that would be a good idea. And after searching for such a class without finding it (which is a bit odd since it’s such an obvious candidate for automation) – I decided to make one.

Now if you are expecting a huge unit with super-duper advanced code, I’m afraid I must disappoint you. This class is about elegance, grace and usefulness. It may be a humble class in the great scheme of things, but as is often the case in life, the simplest things can be of greatest value.

I find it very useful and I hope you find it equally helpful in your projects.

unit AutoRegister;

interface

uses
System.Rtti, System.TypInfo, System.Sysutils, System.Classes;

type

// Our fancy shmancy attribute
TAutoRegister = class(TCustomAttribute)
end;

implementation

// This procedure walks through all classtypes and isolates
// those with our TAutoRegister attribute.
// It then locates the actual classtype and registeres it
// with Delphi's persistance layer
procedure ProcessAutoRegisterAttributes;
var
  ctx : TRttiContext;
  typ : TRttiType;
  attr : TCustomAttribute;
  LRealType: TClass;
  LAccess: PTypeData;
begin
  ctx := TRttiContext.Create();
  try
    for typ in ctx.GetTypes() do
    begin
      if typ.TypeKind = tkClass then
      begin
        for attr in typ.GetAttributes() do
        begin
          if attr is TAutoRegister then
          begin
            LAccess := GetTypeData(typ.Handle);
            if LAccess <> nil then
            begin
              LRealType := LAccess^.ClassType;
              if LRealType <> nil then
              begin
                if LRealType.InheritsFrom(TPersistent)
                or LRealType.InheritsFrom(TInterfacedPersistent) then
                begin
                  RegisterClass( TPersistentClass(LRealType) );
                end;
              end;
              break;
            end;
          end;
        end;
      end;
    end;
  finally
    ctx.Free();
  end;
end;

// We want to register all the classes decorated with our little
// attribute when this unit is loaded into memory
Initialization
begin
  ProcessAutoRegisterAttributes;
end;

end.

That’s basically it. Now to use the attribute just save out the unit and include it as you would any other (just add it to the uses-clause where you need it). Then decorate the classes you want registered automatically.

Remember that only classes that inherit from TPersistent (which includes TInterfacedPersistent) can be registered.

uses AutoRegister;

type
  [TAutoRegister]
  TMyClass = class(TPeristent)
  end;

  [TAutoRegister]
  TMyCoolClass = class(TInterfacedPersistent)
  end;

And voila, no more Registerclass() calls at the bottom of your units. Just neat, clean object oriented code -and as a bonus: I find it easier to read as well.

Cheers!

Advertisements