proplist.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

end;

function TProperty.GetCustom: Boolean;
begin
  Result:=Assigned(FPropData);
end;

function TProperty.GetOwnerProperty: TProperty;
begin
  if Assigned(Owner) then Result:=Owner.Owner
  else Result:=nil;
end;

function TProperty.GetLevel: Integer;
var
  P: TProperty;
begin
  Result:=0;
  P:=OwnerProperty;
  while Assigned(P) do
  begin
    Inc(Result);
    P:=P.OwnerProperty;
  end;
end;

function TProperty.GetPropType: PTypeInfo;
begin
  if Emulated then
    if Custom then Result:=FPropData.PropType
    else
      if Assigned(OwnerProperty) then
        case OwnerProperty.TypeKind of
          tkSet: Result:=TypeInfo(Boolean);
        else Result:=nil;
        end
      else Result:=nil
  else Result:=FPropInfo.PropType^;
end;

function TProperty.GetGetProc: Pointer;
begin
  if Emulated then Result:=nil
  else Result:=FPropInfo.GetProc;
end;

function TProperty.GetSetProc: Pointer;
begin
  if Emulated then Result:=nil
  else Result:=FPropInfo.SetProc;
end;

function TProperty.GetIsStored: Boolean;
begin
  if Emulated then Result:=False
  else Result:=Assigned(FPropInfo.StoredProc);
end;

function TProperty.GetIndex: SmallInt;
begin
  if Emulated then Result:=0
  else Result:=FPropInfo.Index;
end;

function TProperty.GetDefault: LongInt;
begin
  if Emulated then Result:=0
  else Result:=FPropInfo.Default;
end;

function TProperty.GetNameIndex: SmallInt;
begin
  if Emulated then Result:=0
  else Result:=FPropInfo.NameIndex;
end;

function TProperty.GetName: ShortString;
begin
  if Emulated then
    if Custom then Result:=FPropData.PropName
    else
      if Assigned(OwnerProperty) then
        case OwnerProperty.TypeKind of
          tkVariant: Result:='Type';
          tkSet: Result:=GetEnumName(OwnerProperty.CompType,Owner.IndexOf(Self))
        else Result:=''
        end
      else Result:=''
  else Result:=FPropInfo.Name;
end;

function TProperty.GetFullName: string;
var
  OP: TProperty;
begin
  Result:=Name;
  OP:=OwnerProperty;
  while Assigned(OP) do
  begin
    Result:=OP.Name+'.'+Result;
    OP:=OP.OwnerProperty;
  end;
end;

function TProperty.GetTypeName: string;
begin
  Result:=PropType.Name;
end;

function TProperty.GetTypeKind: TTypeKind;
begin
  if Emulated then
    if Custom then Result:=FPropData.PropType.Kind
    else
      if Assigned(OwnerProperty) then
        case OwnerProperty.TypeKind of
          tkSet: Result:=tkEnumeration;
        else Result:=tkUnknown;
        end
      else Result:=tkUnknown
  else Result:=PropType.Kind;
end;

function TProperty.GetOrdType: TOrdType;
begin
  if TypeKind in [tkInteger,tkChar,tkWChar,tkEnumeration,tkSet] then
    Result:=FTypeData.OrdType
  else Result:=TOrdType(0);
end;

function TProperty.GetMinValue: Longint;
begin
  if Emulated and not Custom then
    if Assigned(OwnerProperty) then
      case OwnerProperty.TypeKind of
        tkSet: Result:=Integer(Low(Boolean));
      else Result:=0;
      end
    else Result:=0
  else
    case TypeKind of
      tkInteger,tkChar,tkEnumeration: Result:=FTypeData.MinValue;
      tkSet: Result:=GetTypeData(CompType).MinValue;
    else Result:=0;
    end;
end;

function TProperty.GetMaxValue: Longint;
begin
  if Emulated and not Custom then
    if Assigned(OwnerProperty) then
      case OwnerProperty.TypeKind of
        tkSet: Result:=Integer(High(Boolean));
      else Result:=0;
      end
    else Result:=0
  else
    case TypeKind of
      tkInteger,tkChar,tkEnumeration: Result:=FTypeData.MaxValue;
      tkSet: Result:=GetTypeData(CompType).MaxValue;
    else Result:=0;
    end;
end;

function TProperty.GetBaseType: PTypeInfo;
begin
  if TypeKind=tkEnumeration then Result:=FTypeData.BaseType^
  else Result:=nil;
end;

function TProperty.GetEnumCount: Integer;
begin
  if TypeKind=tkEnumeration then Result:=Succ(MaxValue-MinValue)
  else Result:=0;
end;

function TProperty.GetEName(Value: Integer): string;
begin
  if Emulated and not Custom then
    if Assigned(OwnerProperty) then
      case OwnerProperty.TypeKind of
        tkSet: Result:=GetEnumName(TypeInfo(Boolean),Value);
      else Result:='';
      end
    else Result:=''
  else
    if TypeKind=tkEnumeration then Result:=GetEnumName(PropType,Value)
    else Result:='';
end;

function TProperty.GetEValue(Value: string): Integer;
begin
  if TypeKind=tkEnumeration then Result:=GetEnumValue(PropType,Value)
  else Result:=0;
end;

function TProperty.GetCompType: PTypeInfo;
begin
  if TypeKind=tkSet then Result:=FTypeData.CompType^
  else Result:=nil;
end;

function TProperty.GetFloatType: TFloatType;
begin
  if TypeKind=tkFloat then Result:=FTypeData.FloatType
  else Result:=TFloatType(0);
end;

function TProperty.GetMaxLength: Byte;
begin
  if TypeKind=tkString then Result:=FTypeData.MaxLength
  else Result:=0;
end;

function TProperty.GetClassType: TClass;
begin
  if TypeKind=tkClass then Result:=FTypeData.ClassType
  else Result:=nil;
end;

function TProperty.GetParentInfo: PTypeInfo;
begin
  if TypeKind=tkClass then Result:=FTypeData.ParentInfo^
  else Result:=nil;
end;

function TProperty.GetUnitName: ShortString;
begin
  if TypeKind=tkClass then Result:=FTypeData.UnitName
  else Result:='';
end;

function TProperty.GetMethodKind: TMethodKind;
begin
  if TypeKind=tkMethod then Result:=FTypeData.MethodKind
  else Result:=TMethodKind(0);
end;

function TProperty.GetParamCount: Integer;
begin
  if TypeKind=tkMethod then Result:=FTypeData.ParamCount
  else Result:=0;
end;

function TProperty.GetParamFlags(Index: Integer): TParamFlags;
var
  P: PByte;
  i: Integer;
begin
  Result:=[];
  if TypeKind=tkMethod then
  begin
    P:=PByte(@FTypeData.ParamList);
    for i:=0 to Pred(ParamCount) do
    begin
      if i=Index then
      begin
        Result:=TParamFlags(P^);
        Break;
      end;
      Inc(P);
      Inc(P,Succ(P^));
      Inc(P,Succ(P^));
    end;
  end;
end;

function TProperty.GetParamName(Index: Integer): ShortString;
var
  P: PByte;
  i: Integer;
begin
  Result:='';
  if TypeKind=tkMethod then
  begin
    P:=PByte(@FTypeData.ParamList);
    for i:=0 to Pred(ParamCount) do
    begin
      Inc(P);
      if i=Index then
      begin
        Result:=PShortString(P)^;
        Break;
      end;
      Inc(P,Succ(P^));
      Inc(P,Succ(P^));
    end;
  end;
end;

function TProperty.GetParamType(Index: Integer): ShortString;
var
  P: PByte;
  i: Integer;
begin
  Result:='';
  if TypeKind=tkMethod then
  begin
    P:=PByte(@FTypeData.ParamList);
    for i:=0 to Pred(ParamCount) do
    begin
      Inc(P);
      Inc(P,Succ(P^));
      if i=Index then
      begin
        Result:=PShortString(P)^;
        Break;
      end;
      Inc(P,Succ(P^));
    end;
  end;
end;

function TProperty.GetParameter(Index: Integer): ShortString;
begin
  if TypeKind=tkMethod then
  begin
    Result:='';
    if pfVar in ParamFlags[Index] then Result:=Result+'var ';
    if pfConst in ParamFlags[Index] then Result:=Result+'const ';
    if pfArray in ParamFlags[Index] then Result:=Result+'array of ';
    Result:=Result+ParamNames[Index]+': '+ParamTypes[Index];
  end
  else Result:='';
end;

function TProperty.GetResultType: ShortString;
var
  P: PByte;
  i: Integer;
begin
  if (TypeKind=tkMethod) and (MethodKind=mkFunction) then
  begin
    P:=PByte(@FTypeData.ParamList);
    for i:=0 to Pred(ParamCount) do
    begin
      Inc(P);
      Inc(P,Succ(P^));
      Inc(P,Succ(P^));
    end;
    Result:=PShortString(P)^;
  end
  else Result:='';
end;

function TProperty.GetMethodDeclaration: string;
var
  i: Integer;
begin
  if TypeKind=tkMethod then
  begin
    if MethodKind=mkProcedure then Result:='procedure'
    else Result:='function';
    if ParamCount>0 then
    begin
      Result:=Result+' (';
      for i:=0 to Pred(ParamCount) do
      begin
        Result:=Result+Parameters[i];
        if i<Pred(ParamCount) then Result:=Result+'; '
        else Result:=Result+')';
      end;
    end;
    if MethodKind=mkFunction then Result:=Result+': '+ResultType;
    Result:=Result+' of object;'
  end
  else Result:='';
end;

function TProperty.GetIntfParent: PTypeInfo;
begin
  if TypeKind=tkInterface then Result:=FTypeData.IntfParent^
  else Result:=nil;
end;

function TProperty.GetIntfFlags: TIntfFlags;
begin
  if TypeKind=tkInterface then Result:=FTypeData.IntfFlags
  else Result:=[];
end;

function TProperty.GetGUID: TGUID;
begin
  if TypeKind=tkInterface then Result:=FTypeData.GUID
  else FillChar(Result,SizeOf(Result),0);
end;

function TProperty.GetIntfUnit: ShortString;
begin
  if TypeKind=tkInterface then Result:=FTypeData.IntfUnit
  else Result:='';
end;

{$IFNDEF VERSION3}

function TProperty.GetMinInt64Value: Int64;
begin
  if TypeKind=tkInt64 then Result:=FTypeData.MinInt64Value
  else Result:=0;
end;

function TProperty.GetMaxInt64Value: Int64;
begin
  if TypeKind=tkInt64 then Result:=FTypeData.MaxInt64Value
  else Result:=0;
end;

{$ENDIF}

function TProperty.GetAsFloat: Extended;
begin
  if TypeKind=tkFloat then Result:=GetFloatProp(Instance,FPropInfo)
  else Result:=0;
end;

procedure TProperty.SetAsFloat(const Value: Extended);
begin
  if TypeKind=tkFloat then SetFloatProp(Instance,FPropInfo,Value);
end;

function TProperty.GetAsMethod: TMethod;
begin
  if TypeKind=tkMethod then Result:=GetMethodProp(Instance,FPropInfo)
  else FillChar(Result,SizeOf(Result),0);
end;

procedure TProperty.SetAsMethod(const Value: TMethod);
begin
  if TypeKind=tkMethod then SetMethodProp(Instance,FPropInfo,Value);
end;

function TProperty.GetAsInteger: Longint;
begin
  if TypeKind in tkOrdinals then Result:=GetOrdProp(Instance,FPropInfo)
  else Result:=0;
end;

procedure TProperty.SetAsInteger(const Value: Longint);
begin
  if TypeKind in tkOrdinals then SetOrdProp(Instance,FPropInfo,Value);
end;