RTTI TGUID 不支持？

[iamduo]

如果声明如下：

TMyClass = class
published
property Name:string ...
property Age:Integer ...
end;

用 TypeInfo 单元下的函数是能取到 "Name" 和 "Age" 文字，并且得到类型。

但是我发现，如果属性类型是 TGUID，就取不到了。
我用的是 D2007，有朋友知道，TGUID 属性怎么取的吗？

[sololie]

得实现QueryInterface接口才行

[sololie]

哦，理解错了。 LZ上代码瞅瞅，TGUID类型属性详细怎么定义的

[sololie]

嗯，我看了下，TGUID是不能作为published属性的

  TMyTestClass = class(TPersistent)
  private
    FIID: TGUID;
    FInt: Integer;
  published   // 公布了3个属性，其中一个 TGUID 类型
    property IID: TGUID read FIID;
    property IntVal: Integer read FInt;
    property IntVal2: Integer read FInt;
end;
......
var
  tdata: PTypeData;
begin
  tdata := GetTypeData(TMyTestClass.ClassInfo);
  Showmessage(GUIDToString(tdata.Guid)); // 这里取得该类的 GUID
  Showmessage(IntToStr(tdata.PropCount)); // 可以看到只有2个公布的属性
end;

[simonhehe]

引用 3 楼 sololie 的回复:

嗯，我看了下，TGUID是不能作为published属性的 Delphi/Pascal code?1234567891011121314151617 TMyTestClass = class(TPersistent) private FIID: TGUID; FInt: Integer; published // 公布了3个属性，其中一个 TG……

D7下属性数量是2. XE下属性数量是3.

[simonhehe]

2010后的用Rtti比较爽. XE下测试通过, 2010前的去掉Rtti引用及代码即可

unit Unit15;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyClass = class
  private
    FName: string;
    FAge: integer;
    FID: TGUID;
    procedure SetAge(const Value: integer);
    procedure SetID(const Value: TGUID);
    procedure SetName(const Value: string);
  published
    property ID : TGUID read FID write SetID;
    property Name : string read FName write SetName;
    property Age : integer read FAge write SetAge;
  end;

  TMyClass2 = class
  private
    FName: string;
    FAge: integer;
    FID: TGUID;
    procedure SetAge(const Value: integer);
    procedure SetID(const Value: TGUID);
    procedure SetName(const Value: string);
  public
    property ID : TGUID read FID write SetID;
    property Name : string read FName write SetName;
    property Age : integer read FAge write SetAge;
  end;

  TForm15 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form15: TForm15;

implementation
uses TypInfo, Rtti;  //delphi 2010开始有Rtti, 能识别非published属性及过程,变量等
{$R *.dfm}

//2010前实现方法
function GetClzPropertys(AClz : TClass) : string;
var
  vDataInfo : PTypedata;
  vProps : PPropList;
  i, vPropCount, vPropInfoSize : integer;
begin
  result := '';
  vDataInfo := GetTypeData(AClz.ClassInfo);
  vPropCount := vDataInfo.PropCount;
  vPropInfoSize := SizeOf(TpropInfo);

  GetMem(vProps, vPropInfoSize * vPropCount);
  try
    GetPropInfos(AClz.ClassInfo, vProps);

    for i := 0 to vPropCount - 1 do
    begin
      Result := result + vProps[i].Name + ',' + vProps[i].PropType^.Name + Chr(13);
    end;
  finally
    FreeMem(vProps);
  end;
end;
//2010及后实现方法
function GetClzPropertys2(AClz : TClass) : string;
  var
  ctx: TRttiContext;
  vRttiType: TRttiType;
  p: TRttiProperty;
begin
  result := '';
  vRttiType := ctx.GetType(AClz);

  {
  TMemberVisibility = (mvPrivate, mvProtected, mvPublic, mvPublished);
  TRttiProperty.Visibility : TMemberVisibility
  }
  for p in vRttiType.GetProperties do
  begin
    Result := result + inttostr(Ord(p.Visibility)) + ' ' + p.ToString + Chr(13);
  end;
end;

procedure TForm15.btn1Click(Sender: TObject);
begin
  ShowMessage(GetClzPropertys(TMyClass));
  ShowMessage(GetClzPropertys(TMyClass2));

  ShowMessage(GetClzPropertys2(TMyClass));
  ShowMessage(GetClzPropertys2(TMyClass2));
end;

{ TMyClass }

procedure TMyClass.SetAge(const Value: integer);
begin
  FAge := Value;
end;

procedure TMyClass.SetID(const Value: TGUID);
begin
  FID := Value;
end;

procedure TMyClass.SetName(const Value: string);
begin
  FName := Value;
end;

{ TMyClass2 }

procedure TMyClass2.SetAge(const Value: integer);
begin

end;

procedure TMyClass2.SetID(const Value: TGUID);
begin

end;

procedure TMyClass2.SetName(const Value: string);
begin

end;

end.

[simonhehe]

D7下测试, TypInfo处理Record类型的属性时是否计数与Record类型调用的属性类型有关, XE下不存在此问题. 细研究TypInfo单元应该能找出答案

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TRec = record
    name : string;
    D: word;
  end;
  TRec2 = packed record
    D: word;
  end;

  TMyTestClass = class(TPersistent)
  private
    FIID: TGUID;
    FInt: Integer;
    FMyRec: TRec;
    FMyRec2: TRec2;
    procedure SetMyRec(const Value: TRec);
    procedure SetMyRec2(const Value: TRec2);
  published   // 公布了3个属性，其中一个 TGUID 类型
    property IID: TGUID read FIID;
    property IntVal: Integer read FInt;
    property IntVal2: Integer read FInt;
    property MyRec : TRec read FMyRec write SetMyRec;
    property MyRec2 : TRec2 read FMyRec2 write SetMyRec2;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses TypInfo;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  tdata: PTypeData;
begin
  tdata := GetTypeData(TMyTestClass.ClassInfo);
  Showmessage(GUIDToString(tdata.Guid)); // 这里取得该类的 GUID
  Showmessage(IntToStr(tdata.PropCount)); // 可以看到只有2个公布的属性


end;

{ TMyTestClass }
procedure TMyTestClass.SetMyRec(const Value: TRec);
begin
  FMyRec := Value;
end;

procedure TMyTestClass.SetMyRec2(const Value: TRec2);
begin
  FMyRec2 := Value;
end;

end.

[一如当初]

2007貌似不支持Record的属性。2010才加强了这方面的功能