枚举Delphi中的已发布属性和子属性

时间:2011-03-26 12:12:35

标签: delphi delphi-2009 rtti

如果之前提出过问题,请道歉。我有一些组件的定义如下(如果它是错的,请指导我,因为我是初学者)。我正在尝试的是枚举派生组件的所有已发布属性,尤其是子属性。我可以枚举属性的名称,但是,是否可以枚举在程序执行期间我可以访问元素(如在子属性中)的已发布属性?像getfirst / getnext一样逐个返回属性直到最后?

type
  TStringArray = array of string;

  TGenericColumnDef = class(TPersistent)
  private
    fColumnName        : String;
    fColumnNumber      : Integer;
    fColumnDisplay     : string;
    fColumnDescription : string;
    fColumnDataType    : integer;
    fColumnEditorType  : integer;
 //   fMyEvent: TNotifyEvent;
  protected
  public
    constructor create(AOwner: TComponent); virtual;
  published
    property ColumnName   : String read fColumnName write fColumnName;
    property ColumnNumber : integer read fColumnNumber write fColumnNumber;
    //property MyEvent: TNotifyEvent read fMyEvent write fMyEvent;
  end;

 TGenericAsset = class(Tcomponent) //TPersistent
  private
   { Private declarations }
   fCiteID        : TGenericColumnDef;
   fCiteType      : TGenericColumnDef;
   fTitle         : TGenericColumnDef;
   fAuthor        : TGenericColumnDef;

   fPropertyCount : integer;
   function GetPropertyCount    : integer;
   function GetNextPropertyIndex: integer;
   property CountProperties     : integer read GetPropertyCount;// write fPropertyCount
  protected
   { Protected declarations }
   FOwner: TObject;
  public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;
   destructor  destory ; virtual;
   function    GetColumnNameByColumnNumber(ColumnNumber : Integer) : String;
   function    GetColumnNames : TStringArray;
//   function    GetFirst : TGenericColumnDef;
  published
   property CiteID   : TGenericColumnDef read fCiteID write fCiteID;
   property CiteType : TGenericColumnDef read fCiteType write fCiteType;
   property Title    : TGenericColumnDef read fTitle write fTitle;
   property Author   : TGenericColumnDef read fAuthor write fAuthor;
   //property Nthproperty .........
 end;

//derived from TGenericAsset
type
 TEditedBook = class(TGenericAsset)
  private
  protected
  public
  published
   property CiteID   : TGenericColumnDef read fCiteID write fCiteID;
   property Title    : TGenericColumnDef read fTitle write fTitle;
   property Author   : TGenericColumnDef read fAuthor write fAuthor;
 end;

非常感谢任何要点或指南(示例代码)。 提前谢谢。

1 个答案:

答案 0 :(得分:4)

虽然它没有具体回答你的问题,但下面的代码(几年前由TeamB的Peter Below博士捐赠给旧的Borland Delphi新闻组)展示了如何使用RTTI克隆另一个组件。它显示了如何获取(和设置)子属性,如其他对象,枚举类型等。它应该足以让你开始。我在代码中留下了Peter的注释,以及在函数下面以一些示例代码的形式使用它的示例。 (我还保留了他的代码格式和一些关键字的奇怪字母大小。:)

// Unfortunately there is no easy way to "clone" a component in a way that
// will also preserve event handlers. It can be done using run-time type
// information and routines form the TypInfo unit, though. Try the following
// routine. It is only superficially tested.

Uses TypInfo;

{-- CloneComponent ----------------------------------------------------}
{: Make a copy of a component.
@Param anObj is the component to copy
@Param cloneChildren if true and anObj is a TWincontrol then all its
  child controls will also be copied.
@Param aParent is the parent to use if anObj is a TControl.
@Returns the new object reference. It will have the same owner as anObj
  and passes into the responsibility of the caller.
@Precondition anObj <> nil
@Desc The method creates a new object of the same class as anObj and then
  uses TypInfo routines to copy all published properties. The logic used
  for object properties is similar to what the form loading code uses:
  if a property refers to a TComponent the component reference is copied.
  If it refers to a TPersistent descendent the Assign method is used
  to copy the objects contents. Currently TCollections do not receive
  any special treatment, which may be necessary. <BR>
  Note: the routine will not copy any objects *owned* by anObj, so it
  cannot be used as is to clone a top-level container like a form,
  frame, or datamodule. Those can be copied using WriteComponent and
  ReadComponent with a TMemoryStream.
}{ Created 12.4.2002 by P. Below
-----------------------------------------------------------------------}
Function CloneComponent( anObj: TComponent;
                      cloneChildren: Boolean = false;
                      aParent: TWinControl = nil ): TComponent;
Var
  numProps, I : Integer;
  props: PPropList;
  PropInfo: PPropInfo;
  obj, obj2: TObject;
Begin { CloneComponent }
  Assert( Assigned( anObj ));
  Result := TComponentClass( anObj.ClassType ).Create( anObj.Owner );
  Try
    numProps := GetPropList(anObj, props );
    Try
      For I := 0 To numProps - 1 Do Begin
        PropInfo := props^[I];
        Case PropInfo^.PropType^.Kind Of
          tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
            SetOrdProp( Result, propinfo,
                        GetOrdProp( anObj, propinfo ));
          tkFloat:
            SetFloatProp( Result, propinfo,
                          GetFloatProp( anObj, propinfo ));
          tkString, tkLString:
            If not SameText( propinfo^.name, 'Name' ) Then
              SetStrProp( Result, propinfo,
                          GetStrProp( anObj, propinfo ));
          tkWString:
            SetWideStrProp( Result, propinfo,
                            GetWideStrProp( anObj, propinfo ));
          tkMethod:
            SetMethodProp( Result, propinfo,
                           GetMethodProp( anObj, propinfo ));
          tkInt64:
            SetInt64Prop( Result, propinfo,
                          GetInt64Prop( anObj, propinfo ));
          tkVariant:
            SetVariantProp( Result, propinfo,
                            GetVariantProp( anObj, propinfo ));
          tkInterface:
            SetInterfaceProp( Result, propinfo,
                              GetInterfaceProp( anObj, propinfo ));
          tkClass: Begin
             obj := GetObjectProp( anObj, propinfo );
             If Assigned( obj ) Then Begin
               If obj Is TComponent Then
                 SetObjectProp( Result, propinfo, obj )
               Else If obj Is TPersistent Then Begin
                 obj2 := GetObjectProp( result, propinfo, TPersistent);
                 If Assigned( obj2 ) Then
                   TPersistent( obj2 ).Assign( TPersistent(obj));
               End; { If }
             End; { If }
           End; { Case tkClass }
        Else
          // we don't handle these property types:
          // tkArray, tkRecord, tkDynArray
        End; { Case }
      End; { For }
    Finally
      FreeMem( props );
    End; { Finally }
    If anObj Is TControl Then
      TControl( result ).Parent := aParent;
    If cloneChildren and (anObj Is TWinControl ) Then
      For i:= 0 To TWinControl( anObj ).ControlCount-1 Do
        CloneComponent( TWinControl( anObj ).Controls[i], true,
                        TWinControl( Result ) );
  Except
    Result.Free;
    raise
  End; { Except }
End; { CloneComponent }


procedure TForm1.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  memo1.lines.add('Click on groupbox '+(sender as TComponent).Name );
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  ctrl: TWinControl;
begin
  ctrl := CloneComponent( groupbox1, true, self ) as TWincontrol;
  With ctrl Do
    SetBounds( left, top+height+8, width, height );
  memo1.Lines.add( Format('Controlcount: %d', [ctrl.controlcount]));
end;