Zswang ：

/// 在窗体上面放上尽可能多的控件看看？

uses TypInfo;

function ClassHierarchy(mClass: TClass; mDelimiter: string = '\'): string;

begin

 Result := '';

 while Assigned(mClass) do begin

   Result := mClass.ClassName + mDelimiter + Result;

   mClass := mClass.ClassParent;

 end;

 Delete(Result, Length(Result) - Length(mDelimiter) + 1, MaxInt);

end; { ClassHierarchy }

function StrLeft(const mStr: string; mDelimiter: string): string;

begin

 Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);

end; { StrLeft }

function StrRight(const mStr: string; mDelimiter: string): string;

begin

 if Pos(mDelimiter, mStr) <= 0 then

   Result := ''

 else Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt);

end; { StrRight }

function ListCount(mList: string; mDelimiter: string = ','): Integer;

var

 I, L: Integer;

begin

 Result := 0;

 if mList = '' then Exit;

 L := Length(mList);

 I := Pos(mDelimiter, mList);

 while I > 0 do begin

   mList := Copy(mList, I + Length(mDelimiter), L);

   I := Pos(mDelimiter, mList);

   Inc(Result);

 end;

 Inc(Result);

end; { ListCount }

function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;

var

 I, L, K: Integer;

begin

 L := Length(mList);

 I := Pos(mDelimiter, mList);

 K := 0;

 Result := '';

 while (I > 0) and (K <> mIndex) do begin

   mList := Copy(mList, I + Length(mDelimiter), L);

   I := Pos(mDelimiter, mList);

   Inc(K);

 end;

 if K = mIndex then Result := StrLeft(mList + mDelimiter, mDelimiter);

end; { ListValue }

function TreeNodeString(mTreeNode: TTreeNode; mDelimiter: string = '\'): string;

begin

 Result := '';

 while Assigned(mTreeNode) do begin

   Result := mTreeNode.Text + mDelimiter + Result;

   mTreeNode := mTreeNode.Parent;

 end;

 Delete(Result, Length(Result) - Length(mDelimiter) + 1, MaxInt);

end; { TreeNodeString }

function TreeViewToLineText(mTreeView: TTreeView; mStrings: TStrings;

 mDelimiter: string = '\'): Boolean;

var

 I: Integer;

begin

 Result := False;

 if not (Assigned(mTreeView) and Assigned(mStrings)) then Exit;

 mStrings.Clear;

 for I := 0 to mTreeView.Items.Count - 1 do

   if mTreeView.Items[I].Count = 0 then

     mStrings.Add(TreeNodeString(mTreeView.Items[I], mDelimiter));

 Result := True;

end; { TreeViewToLineText }

function LineTextToTreeView(mStrings: TStrings; mTreeView: TTreeView;

 mDelimiter: string = '\'): Boolean;

var

 I, J, K: Integer;

 vStrPath: string;

 vStrText: string;

 vTreeNode: TTreeNode;

 vBoolFind: Boolean;

begin

 Result := False;

 if not (Assigned(mTreeView) and Assigned(mStrings)) then Exit;

 mTreeView.Items.Clear;

 for I := 0 to mStrings.Count - 1 do begin

   vStrPath := '';

   vTreeNode := nil;

   for J := 0 to ListCount(mStrings[I], mDelimiter) - 1 do begin

     vStrText := ListValue(mStrings[I], J, mDelimiter);

     vStrPath := vStrPath + mDelimiter + vStrText;

     vBoolFind := False;

     for K := 0 to mTreeView.Items.Count - 1 do

       if mDelimiter + TreeNodeString(mTreeView.Items[K], mDelimiter) =

         vStrPath then begin

         vTreeNode := mTreeView.Items[K];

         vBoolFind := True;

         Break;

       end;

     if vBoolFind then Continue;

     vTreeNode := mTreeView.Items.AddChild(vTreeNode, vStrText);

   end;

 end;

 Result := True;

end; { LineTextToTreeView }

procedure TForm1.FormCreate(Sender: TObject);

var

 I: Integer;

begin

 Memo1.WordWrap := False;

 Memo1.Clear;

 for I := 0 to ComponentCount - 1 do

   Memo1.Lines.Add(ClassHierarchy(Components[I].ClassType));

 LineTextToTreeView(Memo1.Lines, TreeView1);

 TreeView1.SaveToFile('c:\temp.txt');

end;