gridef.pas

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

unit GridEF;

interface

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

type
  TGridEditForm = class(TForm)
    ColorDialog1: TColorDialog;
    FontDialog1: TFontDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    sgProp: TStringGrid;
    Panel1: TPanel;
    cbComps: TComboBox;
    MainMenu1: TMainMenu;
    cbForms: TComboBox;
    sgEvt: TStringGrid;
    Options1: TMenuItem;
    RefreshForms1: TMenuItem;
    RefreshComponents1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    RefreshValues1: TMenuItem;
    ComboColor: TComboBox;
    ComboCursor: TComboBox;
    ComboEnum: TComboBox;
    EditNum: TEdit;
    EditStr: TEdit;
    N1: TMenuItem;
    TopMost1: TMenuItem;
    EditCh: TEdit;
    ListSet: TListBox;
    Info1: TMenuItem;
    procedure cbFormsChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cbCompsChange(Sender: TObject);
    procedure sgPropSelectCell(Sender: TObject; Col, Row: Longint;
      var CanSelect: Boolean);
    procedure RefreshForms1Click(Sender: TObject);
    procedure RefreshComponents1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure RefreshValues1Click(Sender: TObject);
    procedure sgDataSelectCell(Sender: TObject; Col, Row: Longint;
      var CanSelect: Boolean);
    procedure sgMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditStrExit(Sender: TObject);
    procedure EditNumExit(Sender: TObject);
    procedure ComboColorDblClick(Sender: TObject);
    procedure ComboColorChange(Sender: TObject);
    procedure ComboCursorChange(Sender: TObject);
    procedure ComboEnumChange(Sender: TObject);
    procedure EditNumKeyPress(Sender: TObject; var Key: Char);
    procedure ComboEnumDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure TopMost1Click(Sender: TObject);
    procedure EditChExit(Sender: TObject);
    procedure ListSetClick(Sender: TObject);
    procedure RefreshOnExit(Sender: TObject);
    procedure sgPropDblClick(Sender: TObject);
    procedure Info1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure EditChange(Sender: TObject);
  private
    // the current component
    CurrComp: TComponent;
    // the real component (if a subproperty is active)
    RealComp: TComponent;
    // are we editing a subproperty?
    EditingSub: Boolean;
    // current form: TForm or TDataModule
    CurrForm: TComponent;
    // current property
    CurrProp: PPropInfo;
    // current row in grid
    CurrRow: Integer;
    // combo box used by AddToCombo method
    Combo: TComboBox;
    // the edit box has been updated?
    EditModified: boolean;
  public
    procedure UpdateFormsCombo;
    procedure UpdateCompsCombo;
    procedure UpdateProps;
    procedure EditStringList (Str: TStrings);
    procedure AddToCombo (const S: String);
  end;

var
  GridEditForm: TGridEditForm;

implementation

{$R *.DFM}

uses
  RTTIHelp, Math;

const
  VersionDescription = 'Object Debugger 1.0 (DDH)';
  VersionRelease = 'Release 1.0 (for "Delphi Developer''s Handbook")';

{initialize the local data to nil and so on...}
procedure TGridEditForm.FormCreate(Sender: TObject);
begin
  CurrForm := nil;
  CurrComp := nil;
  RealComp := nil;
  EditingSub := False;
  // show the first page
  PageControl1.ActivePage := TabSheet1;
  // set first line
  sgProp.Cells [0, 0] := 'Type: (click for detail)';
  sgEvt.Cells [0, 0] := 'Type: (click for detail)';
  // fill input combos
  Combo := ComboCursor;
  GetCursorValues (AddToCombo);
  Combo := ComboColor;
  GetColorValues (AddToCombo);
end;

{call-back used in the code above...}
procedure TGridEditForm.AddToCombo (const S: String);
begin
  Combo.Items.Add (S);
end;

{fill the FormsCombo with the names of the forms of the
current project keep the curent element selected, unless it
has been destroyed. In this last case use the MainForm
as selected form.}
procedure TGridEditForm.UpdateFormsCombo;
var
  I, nForm, Pos: Integer;
  Form: TForm;
begin
  Screen.Cursor := crHourglass;
  cbForms.Items.BeginUpdate;
  try
    cbForms.Items.Clear;
    // for each form of the program
    for nForm := 0 to Screen.FormCount - 1 do
    begin
      Form := Screen.Forms [nForm];
      // if the form is not the one of the ObjectDebugger, add it
      if Form <> self then
        cbForms.Items.AddObject (
          Format ('%s (%s)', [Form.Caption, Form.ClassName]),
          Form);
    end;
    // for each data module
    for I := 0 to Screen.DataModuleCount - 1 do
      cbForms.Items.AddObject (
        Format ('%s (%s)',
          [Screen.DataModules [I].Name,
          Screen.DataModules [I].ClassName]),
          Screen.DataModules [I]);
    // re-select the current form, if exists
    if not Assigned (CurrForm) then
      CurrForm := Application.MainForm;
    Pos := cbForms.Items.IndexOfObject (CurrForm);
    if Pos < 0 then
    begin
      // was a destroyed form, retry...
      CurrForm := Application.MainForm;
      Pos := cbForms.Items.IndexOfObject (CurrForm);
    end;
    cbForms.ItemIndex := Pos;
  finally
    cbForms.Items.EndUpdate;
    Screen.Cursor := crDefault;
  end;
  UpdateCompsCombo;
end;

procedure TGridEditForm.cbFormsChange(Sender: TObject);
begin
  // save the current form or data module
  CurrForm := cbForms.Items.Objects [
    cbForms.ItemIndex] as TComponent;
  // update the list of components
  UpdateCompsCombo;
end;

procedure TGridEditForm.UpdateCompsCombo;
var
  nComp, Pos: Integer;
  Comp: TComponent;
begin
  cbComps.Items.Clear;
  cbComps.Items.AddObject (Format ('%s: %s',
    [CurrForm.Name, CurrForm.ClassName]), CurrForm);
  for nComp := 0 to CurrForm.ComponentCount - 1 do
  begin
    Comp := CurrForm.Components [nComp];
    cbComps.Items.AddObject (Format ('%s: %s',
      [Comp.Name, Comp.ClassName]), Comp);
  end;
  // reselect the current component, if any
  if not Assigned (CurrComp) then
    CurrComp := CurrForm;
  Pos := cbComps.Items.IndexOfObject (CurrComp);
  if Pos < 0 then
    Pos := cbComps.Items.IndexOfObject (CurrForm);
  cbComps.ItemIndex := Pos;
  UpdateProps;
end;

procedure TGridEditForm.cbCompsChange(Sender: TObject);
begin
  // select the new component
  CurrComp := cbComps.Items.Objects [
    cbComps.ItemIndex] as TComponent;
  // update the grid
  UpdateProps;
end;

procedure TGridEditForm.UpdateProps;
// update property and event pages
var
  PropList, SubPropList: TPropList;
  NumberOfProps, NumberOfSubProps, // total number of properties
  nProp, nSubProp, // property loop counter
  nRowProp, nRowEvt: Integer; // items actually added
  SubObj: TPersistent;
begin
  // reset the type
  sgProp.Cells [1, 0] := '';
  sgEvt.Cells [1, 0] := '';

  // get the number of properties
  NumberOfProps := GetTypeData(CurrComp.ClassInfo).PropCount;
  // exaggerate in size...
  sgProp.RowCount := NumberOfProps;
  sgEvt.RowCount := NumberOfProps;

  // get the list of properties and sort it
  GetPropInfos (CurrComp.ClassInfo, @PropList);
  SortPropList(@PropList, NumberOfProps);

  // show the name of each property
  // adding it to the proper page
  nRowProp := 1;
  nRowEvt := 1;
  for nProp := 0 to NumberOfProps - 1 do
  begin
    // if it is a real property
    if PropList[nProp].PropType^.Kind <> tkMethod then
    begin
      // name
      sgProp.Cells [0, nRowProp] := PropList[nProp].Name;
      // value
      sgProp.Cells [1, nRowProp] := GetPropValAsString (
        CurrComp, PropList [nProp]);
      // data
      sgProp.Objects [0, nRowProp] := TObject (PropList[nProp]);
      sgProp.Objects [1, nRowProp] := nil;
      // move to the next line
      Inc (nRowProp);

      // if the property is a class
      if (PropList[nProp].PropType^.Kind = tkClass) then
      begin
        SubObj := TPersistent (GetOrdProp (
          CurrComp, PropList[nProp]));