保存对象为文本：

{

Object Button1: TButton

 Name = Button1

 Tag = 0

 Left = 620

 Top = 275

 Width = 75

 Height = 25

 Cursor = 0

 Hint =

 HelpType = htContext

 HelpKeyword =

 HelpContext = 0

 Action = 0

 Anchors = akLeft,akTop

 BiDiMode = bdLeftToRight

 Cancel = False

 Caption = Button1

 Object SizeConstraints1: TSizeConstraints

   MaxHeight = 0

   MaxWidth = 0

   MinHeight = 0

   MinWidth = 0

 End

 Constraints = Button1

 Default = False

 DragCursor = -12

 DragKind = dkDrag

 DragMode = dmManual

 Enabled = True

 Object MS Sans Serif: TFont

   Charset = 1

   Color = -2147483640

   Height = -11

   Name = MS Sans Serif

   Pitch = fpDefault

   Size = 8

   Style =

 End

 Font = True

 ModalResult = 0

 ParentBiDiMode = True

 ParentFont = True

 ParentShowHint = True

 Object MS Sans Serif: TFont

   Charset = 1

   Color = -2147483640

   Height = -11

   Name = MS Sans Serif

   Pitch = fpDefault

   Size = 8

   Style =

 End

 PopupMenu = True

 ShowHint = False

 TabOrder = 1

 TabStop = True

 Visible = True

 OnClick = TNotifyEvent

 OnContextPopup = TContextPopupEvent

 OnDragDrop = TDragDropEvent

 OnDragOver = TDragOverEvent

 OnEndDock = TEndDragEvent

 OnEndDrag = TEndDragEvent

 OnEnter = TNotifyEvent

 OnExit = TNotifyEvent

 OnKeyDown = TKeyEvent

 OnKeyPress = TKeyPressEvent

 OnKeyUp = TKeyEvent

 OnMouseDown = TMouseEvent

 OnMouseMove = TMouseMoveEvent

 OnMouseUp = TMouseEvent

 OnStartDock = TStartDockEvent

 OnStartDrag = TStartDragEvent

End

}

uses TypInfo ;

function SaveObjectAsText ( AObject : TObject ; Indent : Integer = 0 ): string ;

var

 i : integer ;

 Properties : PPropList ;

 Buffer : TStrings ;

 S : string ;

begin

  if not Assigned ( AObject ) then Exit ;

 Buffer := TStringList . Create ;

  try

   S := AObject . ClassName + '1' ;

   Delete ( S , 1 , 1 );

    if GetPropInfo ( AObject , 'Name' ) <> nil then

     S := GetPropValue ( AObject , 'Name' );

   Buffer . Add ( Format ( '%sObject %s: %s' , [ StringOfChar ( ' ' , Indent * 2 ), S , AObject . ClassName ]));

    for i := 0 to GetPropList ( AObject , Properties ) - 1 do

    begin

      if LowerCase ( Properties [ i ]. Name ) = 'Name' then continue ;

      case PropType ( AObject , Properties [ i ]. Name ) of

       tkClass :

         Buffer . Add ( #13#10 + SaveObjectAsText ( GetObjectProp ( AObject , Properties [ i ]), Indent + 1 ));

{        tkMethod:

         begin

           S := GetPropInfo(AObject, Properties[i].Name).Name + ': ' + Properties[i].Name;

         end;

}

      else

       S := VarToStr ( GetPropValue ( AObject , Properties [ i ]. Name ));

      end ;

     Buffer . Add ( Format ( '%s  %s = %s' , [ StringOfChar ( ' ' , Indent * 2 ), Properties [ i ]. Name , S ]));

    end ;

   Buffer . Add ( StringOfChar ( ' ' , Indent * 2 ) + 'End' );

  finally

   Result := Buffer . Text ;

   Buffer . Free ;

  end ;

end ;