秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
暂时不建议使用fpc 3.3.1的RTTI功能,用带RTTI的fpc重新编译lazarus会出现选择对话框出错的Bug,等完善后再用吧。
本方法适用于fpc 3.3.1(Trunk)2024-07-24之后的fpc trunk。
近日QQ群的SunGod和啊D等发现fpc 3.3.1(Trunk)添加了和delphi一样的rtti功能,但fpc默认是没启用的。
启用RTTI的条件:编译FPC时添加-dENABLE_DELPHI_RTTI
编译fpc用fpcudelux最简单方便,但fpcudelux暂时还不支持fpc rtti编译。下载最新fpcudelux源码,修改installerfpc.pas以下2个位置:

1、第1541-1545行改为以下代码(增加:《+' -dENABLE_DELPHI_RTTI'》)--生成交叉编译环境时应用RTTI:

          NativeCompilerOptions:=Trim(NativeCompilerOptions);
          if (Length(NativeCompilerOptions)>0) then Processor.SetParamNameData('OPT',{MaybeQuotedSpacesOnly}(NativeCompilerOptions+' -dENABLE_DELPHI_RTTI'));

          CrossCompilerOptions:=Trim(CrossCompilerOptions);
          if (Length(CrossCompilerOptions)>0) then Processor.SetParamNameData('CROSSOPT',{MaybeQuotedSpacesOnly}(CrossCompilerOptions+' -dENABLE_DELPHI_RTTI'));
 
2、fpcupdeluxe-2.4.0e\sources\installerfpc.pas的第2062行
      if FileExists(s2) then FPCBuildOptions:=FPCBuildOptions+' -dREVINC';

改为:

  {$ifdef FORCEREVISION}
  if (ModuleName<>_REVISIONFPC) then
  begin
    if FUseRevInc then
    begin
      s2:=ConcatPaths([SourceDirectory,'compiler'])+DirectorySeparator+REVINCFILENAME;
      if FileExists(s2) then FPCBuildOptions:=FPCBuildOptions+' -dREVINC'+' -dENABLE_DELPHI_RTTI';
    end
    else
    begin
      s2:=Trim(ActualRevision);
      s2:=AnsiDequotedStr(s2,'''');
      if ( (Length(s2)>1) AND (s2<>'failure') AND (Pos(' ',s2)=0) ) then
      begin
        Processor.SetParamNameData('REVSTR',s2);
        Processor.SetParamNameData('REVINC','force');
      end;
    end;
  end;
  {$endif FORCEREVISION}

重新编译fpcupdelux后,用新的fpcupdelux再次编译fpc。

RTTI使用demo:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  rtti;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    TreeView1: TTreeView;
  procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  LContext: TRttiContext;
  LType: TRttiType;
  LMethod: TRttiMethod;
  LProperty: TRttiProperty;
  LField: TRttiField;
  LTreeNode1, LTreeNode2: TTreeNode;
begin
  LContext := TRttiContext.Create;
  try
    LType := LContext.GetType(TButton);
    LTreeNode1 := TreeView1.Items.AddChild(nil, LType.ToString);

    LTreeNode2 := TreeView1.Items.AddChild(LTreeNode1, 'Methods');
    for LMethod in LType.GetMethods do
    begin
      TreeView1.Items.AddChild(LTreeNode2, LMethod.Name);
    end;

    LTreeNode2 := TreeView1.Items.AddChild(LTreeNode1, 'Properties');
    for LProperty in LType.GetProperties do
    begin
      TreeView1.Items.AddChild(LTreeNode2, LProperty.Name);
    end;

    LTreeNode2 := TreeView1.Items.AddChild(LTreeNode1, 'Fields');
    for LField in LType.GetFields do
    begin
      TreeView1.Items.AddChild(LTreeNode2, LField.Name);
    end;

    TreeView1.FullExpand;
  finally
    LContext.Free;

  end;
end;

end.

启用RTTI前是读取不到Fields的信息,启用后就可以显示了:

 

posted on 2024-07-31 10:01  秋·风  阅读(100)  评论(0编辑  收藏  举报