listvf.pas

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

unit ListVf;

interface

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

type
  TListViewForm = class(TForm)
    PanelToolbar: TPanel;
    ComboForms: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboComps: TComboBox;
    ButtRefresh: TSpeedButton;
    ButtonAbout: TSpeedButton;
    TabControl1: TTabControl;
    TreeProp: TTreeView;
    procedure ComboFormsChange(Sender: TObject);
    procedure ComboCompsChange(Sender: TObject);
    procedure TreePropDblClick(Sender: TObject);
    procedure ButtonAboutClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ButtRefreshClick(Sender: TObject);
  public
    procedure UpdateComboForms;
    procedure ShowProperties (Obj: TObject;
      BaseNode: TTreeNode);
  end;

var
  ListViewForm: TListViewForm;

implementation

uses
  RTTIHelp;

{$R *.DFM}

// startup code
procedure TListViewForm.UpdateComboForms;
var
  I: Integer;
begin
  // empty the combo
  ComboForms.Clear;
  // copy the name of each form
  // but the current one
  for I := 0 to Screen.FormCount - 1 do
    if (Screen.Forms [I] <> self) then
      ComboForms.Items.Add (
        Screen.Forms[I].Name);
  // select the main form
  ComboForms.ItemIndex := ComboForms.Items.IndexOf (
    Application.MainForm.Name);
  ComboFormsChange (ComboForms);
end;

procedure TListViewForm.ComboFormsChange(Sender: TObject);
var
  I, nIndex: Integer;
  CurrentForm: TForm;
  CurFormName: string;
begin
  // update components combo
  ComboComps.Clear;
  // get the current form (if it still exists)
  CurrentForm := nil;
  CurFormName := ComboForms.Text;
  for I := 0 to Screen.FormCount - 1 do
    if Screen.Forms[I].Name = CurFormName then
      CurrentForm := Screen.Forms[I];
  // if the form has been destroyed
  if CurrentForm = nil then
    MessageDlg ('Form not found: Update the list',
      mtError, [mbYes], 0)
  else
  begin
    // list the components
    for I := 0 to CurrentForm.ComponentCount - 1 do
      ComboComps.Items.AddObject (
        CurrentForm.Components [I].Name,
        CurrentForm.Components [I]);
    // add the form itself
    nIndex := ComboComps.Items.AddObject (
      CurrentForm.Name, CurrentForm);
    // select the form
    ComboComps.ItemIndex := nIndex;
    ComboCompsChange (ComboComps);
  end;
end;

procedure TListViewForm.ComboCompsChange(Sender: TObject);
var
  CurrComp: TComponent;
begin
  // get the current component
  CurrComp := ComboComps.Items.Objects [
    ComboComps.ItemIndex] as TComponent;
  TreeProp.Items.BeginUpdate;
  try
    TreeProp.Items.Clear;
    // update the list of properties
    ShowProperties (CurrComp, nil);
  finally
    // re-enable treeview
    TreeProp.Items.EndUpdate;
  end;
end;

procedure TListViewForm.ShowProperties (
  Obj: TObject; BaseNode: TTreeNode);
var
  PropList: PPropList;
  CurrNode: TTreeNode;
  nTotProperties, nProp: Integer;
  fPropsPage: Boolean;
begin
  // get the number of properties
  nTotProperties := GetTypeData(Obj.ClassInfo).PropCount;
  if nTotProperties <> 0 then
  begin
    fPropsPage := (TabControl1.TabIndex = 0);
    // get the list of properties (sorted)
    GetMem (PropList, sizeof (PPropInfo) * nTotProperties);
    try
      GetPropInfos (Obj.ClassInfo, PropList);
      SortPropList(PropList, nTotProperties);

      // show the name of each property or event
      for nProp := 0 to nTotProperties - 1 do
        // if we've asked for properties and it is not a method
        // or we've asked for methods and we find one...
        if (fPropsPage and (PropList[nProp].PropType^.Kind <> tkMethod)) or
            (not fPropsPage and (PropList[nProp].PropType^.Kind = tkMethod)) then
        begin
          // add the property to the tree
          CurrNode := TreeProp.Items.AddChildObject (
            BaseNode,
            Format ('%s: %s', [PropList[nProp].Name,
              GetPropValAsString (Obj, PropList[nProp])]),
              TObject (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
            ShowProperties (
              TObject (GetOrdProp (Obj, PropList[nProp])),
              CurrNode);
        end;
    finally
      FreeMem (PropList, sizeof (PPropInfo) * nTotProperties);
    end;
  end;
end;

procedure TListViewForm.TreePropDblClick(Sender: TObject);
var
  CurrProp: PPropInfo;
begin
  // show the Rtti details for the property type
  CurrProp := PPropInfo (TreeProp.Selected.Data);
  if CurrProp <> nil then
    ShowRttiDetail (CurrProp.PropType^);
end;

procedure TListViewForm.ButtonAboutClick(Sender: TObject);
begin
  MessageDlg ('ListView, a Run-time Property Viewer'#13 +
    'from the "Delphi Developer''s Handbook", Sybex',
    mtInformation, [mbOK], 0);
end;

procedure TListViewForm.FormActivate(Sender: TObject);
begin
  UpdateComboForms;
end;

procedure TListViewForm.ButtRefreshClick(Sender: TObject);
begin
  UpdateComboForms;
end;

end.