Instantly share code, notes, and snippets.

Embed
What would you like to do?
EnumHelper.pas
unit EnumHelper;
interface
uses
System.SysUtils,
System.TypInfo,
System.Rtti;
type
{$REGION 'Exception types'}
EEnumOutOfRange = class(System.SysUtils.EArgumentOutOfRangeException);
EEnumNameNotFound = class(System.SysUtils.Exception);
EAttributeNotFound = class(System.SysUtils.Exception);
{$ENDREGION}
{$REGION 'EnumNamesAttribute'}
/// <summary> Este atributo permite anotar un tipo enumerativo con una lista de valores que identifican
/// a cada valor de dicho tipo </summary>
/// <summary> El constructor recibe un identificador y un string delimitado por un caracter, podria verse
/// a ese string como un "array". Esto es implementado asi debido a una limitacion de Delphi, ya que no se permite
/// inicializar atributos con arreglos (aunque sean constantes) </summary>
/// <summary> Para obtener el valor se debe usar el ayudante Enum<T>.EnumName(Identificador, Valor) </summary>
/// <summary> Un ejemplo de uso seria: </summary>
/// <summary> type </summary>
/// <summary> [EnumNames('TestEnumAttribute', 'Hello, World')] </summary>
/// <summary> TTestEnumeration = (First, Second); </summary>
/// <summary> Enum<TTestEnumeration>.EnumName('TestEnumAttribute', TTestEnumeration.First) --> 'Hello' </summary>
EnumNamesAttribute = class(TCustomAttribute)
strict private
FIdentifier: string;
FNames: TArray<string>;
public
constructor Create(const Identifier, Names: string; const Delimiter: string = ',');
function NameOf<T: record {: enum}>(const Value: T): string;
property Identifier: string read FIdentifier;
property Names: TArray<string> read FNames;
end;
{$ENDREGION}
{$REGION 'Enum<T>'}
/// <summary> Record que contiene metodos estaticos para trabajar con tipos enums </summary>
Enum<T: record {: enum}> = record
strict private
class function EnumTypeInfo: PTypeInfo; static; inline;
class function EnumTypeData: PTypeData; static; inline;
class function EnumNamesAttributes: TArray<EnumNamesAttribute>; static;
class function EnumNameAttribute(const Identifier: string): EnumNamesAttribute; static;
class function TryGetEnumNameAttribute(const Identifier: string; out Attribute: EnumNamesAttribute): Boolean; static;
class function TryGetEnumName(const Identifier: string; const Value: T; out Name: string): Boolean; static;
class procedure AttributeNotFound(const Identifier: string); static;
class procedure NameNotFound(const Identifier: string; const Value: T); static;
class procedure OutOfRange(const Value: T; const Namespace, MethodName: string); static;
public
/// <summary> El nombre del tipo enum </summary>
class function TypeName: string; static; inline;
/// <summary> El nombre del valor enum </summary>
class function ValueName(const Value: T): string; static; inline;
/// <summary> Devuelve el valor del tipo enum anotado por el atributo EnumNames </summary>
/// <summary> Si el enum no esta anotado por el atributo EnumNames, o no esta anotado por un atributo
/// EnumNames con el identificador indicado, se eleva una excepcion EEnumNameNotFound </summary>
/// <remarks> Ver EnumNamesAttribute </remarks>
class function EnumName(const Identifier: string; const Value: T): string; static; inline;
/// <summary> Devuelve el valor del tipo enum anotado por el atributo EnumNames </summary>
/// <summary> En lugar de elevar una excepcion EEnumNameNotFound, se devuelve el valor Default </summary>
/// <summary> Si Default = EmptyStr se devuelve ValueName(Value) </summary>
/// <remarks> Ver EnumNamesAttribute </remarks>
class function EnumNameOrDefault(const Identifier: string; const Value: T; const Default: string = ''): string; static; inline;
/// <summary> Devuelve todos los nombres con los que fue anotado el enum </summary>
class function EnumNames(const Identifier: string): TArray<string>; static; inline;
/// <summary> Devuelve el valor enum dado un Ordinal </summary>
class function Parse(const Ordinal: Integer): T; static; inline;
/// <summary> Convierte el valor enum a su correspondiente Ordinal </summary>
class function ToInteger(const Value: T): Integer; static; inline;
/// <summary> El valor maximo del enum. Equivalente a Ord(High(T)) </summary>
class function MaxValue: Integer; static; inline;
/// <summary> El valor maximo del enum. Equivalente a Ord(Low(T)) </summary>
class function MinValue: Integer; static; inline;
/// <summary> Devuelve True si el valor del tipo enum se encuentra dentro del rango permitido </summary>
class function InRange(const Value: T): Boolean; overload; static;
/// <summary> Devuelve True si el entero se encuentra dentro del rango permitido del tipo enum </summary>
class function InRange(const Value: Integer): Boolean; overload; static;
/// <summary> Eleva una excepcion EEnumOutOfRange si el valor del tipo enum esta fuera del rango
// permitido </summary>
/// <param name="Value"> El valor a testear </param>
/// <param name="Namespace"> Describe el "contexto" de quien invoca a este metodo (ej clase o unidad) </param>
/// <param name="MethodName"> Nombre del metodo que invoco a esta rutina </param>
class procedure CheckInRange(const Value: T; const Namespace, MethodName: string); static;
/// <summary> Cantidad de elementos del enum </summary>
class function Count: Integer; static;
/// <summary> Devuelve un Array con los elementos del enum </summary>
class function AsArray: TArray<T>; static;
end;
{$ENDREGION}
{$REGION 'Rtti'}
/// <summary> Mantiene una instancia de TRttiContext privada al que delega los metodos publicos </summary>
Rtti = record
public type
TAttributeClass = class of TCustomAttribute;
TRttiMemberPredicate = reference to function(const RttiMember: TRttiMember): Boolean;
strict private
class var FContext: TRttiContext;
class var ContextSentinel: string;
class function GetContext: TRttiContext; static;
class property Context: TRttiContext read GetContext;
public
/// <summary> Obtiene el TRttiType de la clase de una objeto determinado </summary>
class function GetObjectRtti(const AObject: TObject): TRttiType; static;
/// <summary> Obtiene el TRttiType para un clase determinada </summary>
class function GetClassRtti(const AClass: TClass): TRttiType; static;
/// <summary> Obtiene el TRttiType para un tipo determinado </summary>
class function GetTypeRtti(const ATypeInfo: PPTypeInfo): TRttiType; static;
/// <summary> Obtiene el TRttiType para un enum </summary>
class function GetEnumRtti<T: record {: enum}>: TRttiType; static;
end;
{$ENDREGION}
{$REGION 'TRttiNamedObjectHelper'}
TRttiNamedObjectHelper = class helper for System.Rtti.TRttiNamedObject
strict private
procedure AttributeNotFoundError(const AttributeName: string);
public
/// <summary> Devuelve el atributo de la clase determinada por el tipo generico </summary>
/// <remarks> Eleva una excepcion EAttributeNotFound si el tipo no esta anotado con ese atributo </remarks>
function GetAttribute<T: TCustomAttribute>: T;
/// <summary> Este metodo ya lo provee la RTTI de Delphi, pero necesito sobrecargarlo porque la version
/// generica lo oculta </summary>
function GetAttributes: TArray<TCustomAttribute>; overload;
/// <summary> Devuelve todos los atributos de la clase determinada por el tipo generico </summary>
function GetAttributes<T: TCustomAttribute>: TArray<T>; overload;
end;
{$ENDREGION}
implementation
uses
System.Types,
System.Math,
System.StrUtils,
System.Generics.Collections;
{$REGION 'Enum<T>'}
class function Enum<T>.InRange(const Value: T): Boolean;
begin
Result := InRange(ToInteger(Value));
end;
class function Enum<T>.InRange(const Value: Integer): Boolean;
begin
Result := System.Math.InRange(Value, Enum<T>.MinValue, Enum<T>.MaxValue);
end;
class function Enum<T>.MaxValue: Integer;
begin
Result := Enum<T>.EnumTypeData.MaxValue;
end;
class function Enum<T>.MinValue: Integer;
begin
Result := Enum<T>.EnumTypeData.MinValue;
end;
class function Enum<T>.ToInteger(const Value: T): Integer;
begin
Result := 0;
System.Move(Value, Result, System.SizeOf(Value));
end;
class function Enum<T>.TypeName: string;
begin
Result := string(Enum<T>.EnumTypeInfo.Name);
end;
class function Enum<T>.ValueName(const Value: T): string;
begin
Result := System.TypInfo.GetEnumName(Enum<T>.EnumTypeInfo, Enum<T>.ToInteger(Value));
end;
class function Enum<T>.EnumTypeData: PTypeData;
begin
Result := System.TypInfo.GetTypeData(Enum<T>.EnumTypeInfo);
end;
class function Enum<T>.EnumTypeInfo: PTypeInfo;
begin
Result := System.TypeInfo(T);
end;
class procedure Enum<T>.CheckInRange(const Value: T; const Namespace, MethodName: string);
begin
if not Enum<T>.InRange(Value) then
Enum<T>.OutOfRange(Value, Namespace, MethodName);
end;
class function Enum<T>.Count: Integer;
begin
Result := Enum<T>.MaxValue - Enum<T>.MinValue + 1;
end;
class procedure Enum<T>.OutOfRange(const Value: T; const Namespace, MethodName: string);
const
SEnumOutOfRange = '%s.%s :: %d is out of range for enum %s';
begin
raise EEnumOutOfRange.CreateFmt(SEnumOutOfRange, [Namespace, MethodName, ToInteger(Value), TypeName]);
end;
class function Enum<T>.Parse(const Ordinal: Integer): T;
begin
Assert(System.SizeOf(Result) <= System.SizeOf(Ordinal));
Move(Ordinal, Result, System.SizeOf(Result));
end;
class function Enum<T>.EnumNamesAttributes: TArray<EnumNamesAttribute>;
begin
Result := Rtti.GetEnumRtti<T>.GetAttributes<EnumNamesAttribute>;
end;
class function Enum<T>.TryGetEnumNameAttribute(const Identifier: string; out Attribute: EnumNamesAttribute): Boolean;
var
Attributes: TArray<EnumNamesAttribute>;
Each: EnumNamesAttribute;
begin
Attributes := EnumNamesAttributes;
for Each in Attributes do
begin
if Each.Identifier = Identifier then
begin
Attribute := Each;
Exit(True);
end;
end;
Result := False;
end;
class function Enum<T>.EnumNameAttribute(const Identifier: string): EnumNamesAttribute;
begin
if not Enum<T>.TryGetEnumNameAttribute(Identifier, Result) then
AttributeNotFound(Identifier);
end;
class function Enum<T>.TryGetEnumName(const Identifier: string; const Value: T; out Name: string): Boolean;
var
Attribute: EnumNamesAttribute;
begin
if Enum<T>.TryGetEnumNameAttribute(Identifier, Attribute) then
begin
Name := Attribute.NameOf<T>(Value);
Result := True;
end
else
Result := False;
end;
class function Enum<T>.EnumNames(const Identifier: string): TArray<string>;
var
I: Integer;
Attribute: EnumNamesAttribute;
begin
Attribute := EnumNameAttribute(Identifier);
System.SetLength(Result, System.Length(Attribute.Names));
for I := System.Low(Attribute.Names) to System.High(Attribute.Names) do
Result[I] := Attribute.Names[I];
end;
class function Enum<T>.EnumName(const Identifier: string; const Value: T): string;
begin
if not Enum<T>.TryGetEnumName(Identifier, Value, Result) then
NameNotFound(Identifier, Value);
end;
class function Enum<T>.EnumNameOrDefault(const Identifier: string; const Value: T; const Default: string): string;
begin
if not Enum<T>.TryGetEnumName(Identifier, Value, Result) then
begin
if Default.IsEmpty then
Result := Enum<T>.ValueName(Value)
else
Result := Default;
end;
end;
class procedure Enum<T>.NameNotFound(const Identifier: string; const Value: T);
const
SEnumNameNotFound = 'EnumName not found for %s.%s with identifier %s';
begin
raise EEnumNameNotFound.CreateFmt(SEnumNameNotFound, [TypeName, ValueName(Value), Identifier]);
end;
class procedure Enum<T>.AttributeNotFound(const Identifier: string);
const
SAttributeNotFound = '%s is not annotated with EnumName Attribuye with identifier %s';
begin
raise EEnumNameNotFound.CreateFmt(SAttributeNotFound, [TypeName, Identifier]);
end;
class function Enum<T>.AsArray: TArray<T>;
var
I: Integer;
begin
System.SetLength(Result, Enum<T>.Count);
for I := System.Low(Result) to System.High(Result) do
Result[I] := Enum<T>.Parse(I);
end;
{$ENDREGION}
{$REGION 'EnumNamesAttribute'}
constructor EnumNamesAttribute.Create(const Identifier, Names: string; const Delimiter: string = ',');
var
Index: Integer;
SplitValues: System.Types.TStringDynArray;
begin
inherited Create;
FIdentifier := Identifier;
SplitValues := System.StrUtils.SplitString(Names, Delimiter);
System.SetLength(FNames, System.Length(SplitValues));
for Index := System.Low(SplitValues) to System.High(SplitValues) do
FNames[Index] := SplitValues[Index];
end;
function EnumNamesAttribute.NameOf<T>(const Value: T): string;
var
Index: Integer;
begin
Index := Enum<T>.ToInteger(Value);
if System.Math.InRange(Index, System.Low(FNames), System.High(FNames)) then
Result := FNames[Index]
else
Result := System.SysUtils.EmptyStr;
end;
{$ENDREGION}
{$REGION 'Rtti'}
class function Rtti.GetContext: TRttiContext;
begin
if ContextSentinel = EmptyStr then
begin
FContext := TRttiContext.Create;
ContextSentinel := '@';
end;
Result := FContext;
end;
class function Rtti.GetEnumRtti<T>: TRttiType;
begin
Result := GetTypeRtti(TypeInfo(T));
end;
class function Rtti.GetTypeRtti(const ATypeInfo: PPTypeInfo): TRttiType;
begin
Result := Context.GetType(ATypeInfo);
end;
class function Rtti.GetClassRtti(const AClass: TClass): TRttiType;
begin
Result := Context.GetType(AClass.ClassInfo);
end;
class function Rtti.GetObjectRtti(const AObject: TObject): TRttiType;
begin
Result := GetClassRtti(AObject.ClassType);
end;
{$ENDREGION}
{$REGION 'TRttiNamedObjectHelper'}
procedure TRttiNamedObjectHelper.AttributeNotFoundError(const AttributeName: string);
begin
raise EAttributeNotFound.Create('Attribute: ' + AttributeName + ' not found');
end;
function TRttiNamedObjectHelper.GetAttribute<T>: T;
var
Each: TCustomAttribute;
begin
for Each in GetAttributes do
begin
if Each is T then
Exit(Each as T);
end;
AttributeNotFoundError(T.QualifiedClassName);
end;
function TRttiNamedObjectHelper.GetAttributes: TArray<TCustomAttribute>;
begin
Result := inherited GetAttributes;
end;
function TRttiNamedObjectHelper.GetAttributes<T>: TArray<T>;
var
Items: TList<T>;
Each: TCustomAttribute;
begin
Items := TList<T>.Create;
try
for Each in GetAttributes do
begin
if Each is T then
Items.Add(Each);
end;
Result := Items.ToArray;
finally
Items.Free;
end;
end;
{$ENDREGION}
end.
@devapromix

This comment has been minimized.

Show comment
Hide comment
@devapromix

devapromix Aug 18, 2018

Thank you very much. It is really convenient to work with enums.

devapromix commented Aug 18, 2018

Thank you very much. It is really convenient to work with enums.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment