treevf.pas

Delphi高级开发指南是开发程序的好帮手

unit TreeVF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TypInfo, ExtCtrls, Tabs, ComCtrls, Grids, Outline, Buttons,
  DsgnIntf;

type
  TTreeViewForm = class(TForm)
    TreeComp: TTreeView;
    PanelToolbar: TPanel;
    SpeedToolUpdateComp: TSpeedButton;
    SpeedToolUpdateProp: TSpeedButton;
    PanelProp: TPanel;
    TreeProp: TTreeView;
    TabSet1: TTabSet;
    SpeedToolAbout: TSpeedButton;
    LabelType: TLabel;
    ColorDialog1: TColorDialog;
    FontDialog1: TFontDialog;
    Splitter1: TSplitter;
    procedure TabSet1Change(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure TreeCompChange(Sender: TObject; Node: TTreeNode);
    procedure TreePropChange(Sender: TObject; Node: TTreeNode);
    procedure SpeedToolUpdateCompClick(Sender: TObject);
    procedure SpeedToolUpdatePropClick(Sender: TObject);
    procedure SpeedToolAboutClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    CurrentComponent: TComponent;
    CurrentProperty: PPropInfo;
  public
    procedure UpdateCompTree;
    procedure ListSubComponents (
      BaseComp: TComponent; BaseNode: TTreeNode);
    procedure UpdateProperties (
      CurrComp: TComponent; Props: Boolean);
    procedure UpdateSubProperties (Obj: TComponent;
      ClassType: TClass; BaseNode: TTreeNode; Props: Boolean);
  end;

var
  TreeViewForm: TTreeViewForm;

implementation

{$R *.DFM}

uses
  RttiHelp;

procedure TTreeViewForm.UpdateCompTree;
var
  CurrNode: TTreeNode;
  CurrForm: TForm;
  nForm: Integer;
begin
  // show the hourglass cursor
  Screen.Cursor := crHourglass;
  // disable the output and the events
  TreeProp.Items.BeginUpdate;
  TreeComp.Items.BeginUpdate;
  TreeComp.OnChange := nil;
  TreeProp.OnChange := nil;
  try
    // empty the trees
    TreeProp.Items.Clear;
    TreeComp.Items.Clear;
    // for each form of the program
    for nForm := 0 to Screen.FormCount - 1 do
    begin
      CurrForm := Screen.Forms[nForm];
      if CurrForm <> self then
      begin
        // if the form is not the current one, show it
        CurrNode := TreeComp.Items.AddObject (
          nil, // no parent
          Format ('%s (%s)', [CurrForm.Caption, CurrForm.ClassName]),
          Pointer (CurrForm));
          // add the components of the form
          if CurrForm.ComponentCount > 0 then
            ListSubComponents (CurrForm, CurrNode);
      end;
    end;
  finally
    // remove the hourglass cursor
    Screen.Cursor := crDefault;
    // enable the output and the events
    TreeComp.OnChange := TreeCompChange;
    TreeProp.OnChange := TreePropChange;
    TreeComp.Items.EndUpdate;
    TreeProp.Items.EndUpdate;
  end;
end;

procedure TTreeViewForm.ListSubComponents (
  BaseComp: TComponent; BaseNode: TTreeNode);
var
  nComp: Integer;
  CurrNode: TTreeNode;
  CurrComp: TComponent;
begin
  // for each component owned by the current one
  // (possibly the form, but not always)
  for nComp := 0 to BaseComp.ComponentCount - 1 do
  begin
    CurrComp := BaseComp.Components [nComp];
    CurrNode := TreeComp.Items.AddChildObject (
      BaseNode,
      Format ('%s: %s', [CurrComp.Name, CurrComp.ClassName]),
      CurrComp);
    // recursively calls itself
    if CurrComp.ComponentCount > 0 then
      ListSubComponents (CurrComp, CurrNode);
  end;
end;

procedure TTreeViewForm.TreeCompChange(Sender: TObject; Node: TTreeNode);
begin
  // a new component has been selected
  Caption := Format ('%s [ %s ]',
    ['Object Debugger', TComponent (Node.Data).Name]);
  CurrentComponent := TComponent (Node.Data);
  // update the properties window or the events window
  UpdateProperties (CurrentComponent, TabSet1.TabIndex = 0);
end;

procedure TTreeViewForm.UpdateProperties (CurrComp: TComponent; Props: Boolean);
begin
  Screen.Cursor := crHourglass;
  TreeProp.Items.BeginUpdate;
  TreeProp.OnChange := nil;
  TreeProp.Items.Clear;
  try
    UpdateSubProperties (CurrComp, // component
      CurrComp.ClassType, // class type
      nil, // base tree node
      Props); // props or events
  finally
    // re-enable everything
    Screen.Cursor := crDefault;
    TreeProp.OnChange := TreePropChange;
    TreeProp.Items.EndUpdate;
  end;
end;

procedure TTreeViewForm.UpdateSubProperties (Obj: TComponent;
  ClassType: TClass; BaseNode: TTreeNode; Props: Boolean);
var
  PropList: TPropList;
  CurrNode: TTreeNode;
  NumberOfProps, nProp: Integer;
begin
  // get the number of properties
  NumberOfProps := GetTypeData(ClassType.ClassInfo).PropCount;
  // get the list of properties
  GetPropInfos (ClassType.ClassInfo, @PropList);

  // show the name of each property or event
  for nProp := 0 to NumberOfProps - 1 do
    // if we've asked for properties and it is not a method
    // or we've asked for a method and we find one...
    if (Props and (PropList[nProp].PropType^.Kind <> tkMethod)) or
        (not Props and (PropList[nProp].PropType^.Kind = tkMethod)) then
    begin
      // add the property
      CurrNode := TreeProp.Items.AddChildObject (
        BaseNode,
        Format ('%s: %s', [PropList[nProp].Name,
          GetPropValAsString (Obj, PropList[nProp])]),
        Pointer (PropList[nProp]));
      // if the property is a class and the object exists
      // add its subproperties (with a recursive call)
      if (PropList[nProp].PropType^.Kind = tkClass) and
          (GetOrdProp (Obj, PropList[nProp]) <> 0) then
        UpdateSubProperties (
          TComponent (GetOrdProp (Obj, PropList[nProp])),
          GetTypeData (PropList[nProp].PropType^).ClassType,
          CurrNode, Props);
    end;
end;

// UI code

procedure TTreeViewForm.TabSet1Change(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  // update the second treeview, with properties or events
  UpdateProperties (CurrentComponent, NewTab = 0);
end;

procedure TTreeViewForm.TreePropChange(Sender: TObject; Node: TTreeNode);
var
  TempProp: PPropInfo;
begin
  // get the active component in the first treeview
  // (might have changed accessing to a sub-property)
  CurrentComponent := TComponent (TreeComp.Selected.Data);

  // get the selected property
  CurrentProperty := PPropInfo (Node.Data);

  // show the name of the data type in the label
  LabelType.Caption := CurrentProperty.PropType^.Name;

  // if it is a subproperty, select the "parent"
  // property as the current component
  if Node.Level > 0 then
  begin
    TempProp := PPropInfo (Node.Parent.Data);
    CurrentComponent := TComponent (
      GetOrdProp (CurrentComponent, TempProp));
  end;
end;

// toolbar buttons OnClick event handlers

procedure TTreeViewForm.SpeedToolUpdateCompClick(Sender: TObject);
begin
  // update the tree of components
  UpdateCompTree;
end;

procedure TTreeViewForm.SpeedToolUpdatePropClick(Sender: TObject);
var
  Node: TTreeNode;
begin
  // update the tree of properties, if a component is selected
  Node := TreeComp.Selected;
  if Node <> nil then
  begin
    CurrentComponent := TComponent (Node.Data);
    UpdateProperties (CurrentComponent, TabSet1.TabIndex = 0);
  end
  else
    ShowMessage ('No component selected');
end;

procedure TTreeViewForm.SpeedToolAboutClick(Sender: TObject);
begin
  // Show an about box
  MessageDlg ('Run-time Property Tree View' +
    #13'An old version of the Object Debugger' +
    #13#13'Copyright Marco Cant