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]));
        if (SubObj <> nil) and not (SubObj is TComponent) then
        begin
          NumberOfSubProps := GetTypeData(SubObj.ClassInfo).PropCount;
          if NumberOfSubProps > 0 then
          begin
            // add plus sign
            sgProp.Cells [0, nRowProp - 1] := '+' +
              sgProp.Cells [0, nRowProp - 1];
            // add space for subproperties...
            sgProp.RowCount := sgProp.RowCount + NumberOfSubProps;
            // get the list of subproperties and sort it
            GetPropInfos (subObj.ClassInfo, @SubPropList);
            SortPropList(@SubPropList, NumberOfSubProps);
            // show the name of each subproperty
            for nSubProp := 0 to NumberOfSubProps - 1 do
            begin
              // if it is a real property
              if SubPropList[nSubProp].PropType^.Kind <> tkMethod then
              begin
                // name (indented)
                sgProp.Cells [0, nRowProp] :=
                   '    ' + SubPropList[nSubProp].Name;
                // value
                sgProp.Cells [1, nRowProp] := GetPropValAsString (
                  SubObj, SubPropList [nSubProp]);
                // data
                sgProp.Objects [0, nRowProp] :=
                  TObject (SubPropList[nSubProp]);
                sgProp.Objects [1, nRowProp] := SubObj;
                Inc (nRowProp);
              end; // if
            end; // for
          end;
        end;
      end; // adding subproperties
    end
    else // it is an event
    begin
      // name
      sgEvt.Cells [0, nRowEvt] := PropList[nProp].Name;
      // value
      sgEvt.Cells [1, nRowEvt] := GetPropValAsString (
        CurrComp, PropList [nProp]);
      // data
      sgEvt.Objects [0, nRowEvt] := TObject (PropList[nProp]);
      // next
      Inc (nRowEvt);
    end;
  end; // for
  // set the actual rows
  sgProp.RowCount := nRowProp;
  sgEvt.RowCount := nRowEvt;
end;

////////////////////////////////////////////////////////////
//////////// string grid selections and clicks /////////////
////////////////////////////////////////////////////////////

procedure TGridEditForm.sgPropSelectCell(Sender: TObject; Col, Row: Longint;
  var CanSelect: Boolean);
var
  sg: TStringGrid;
  ppInfo: PPropInfo;
  I: Integer;

procedure PlaceControl (Ctrl: TWinControl);
begin
  Ctrl.BringToFront;
  Ctrl.Show;
  Ctrl.BoundsRect := sg.CellRect (Col, Row);
  Ctrl.SetFocus;
end;

begin
  sg := Sender as TStringGrid;
  // get the data and show it in the first line
  ppInfo := PPropInfo (sg.Objects [0, Row] );
  sg.Cells [1, 0] := ppInfo.PropType^.Name;
  {$IFDEF VER100}
  sg.Objects [1, 0] := Pointer (ppInfo.PropType^);
  {$ELSE} // Delphi 2
  sg.Objects [1, 0] := Pointer (ppInfo.PropType);
  {$ENDIF}
  // if second column activate the proper editor
  if Col = 1 then
  begin
    CurrProp := ppInfo;
    CurrRow := Row;
    // if it is a subproperty, select the value of
    // the property as the current component
    if sg.Objects [1, Row] <> nil then
    begin
      RealComp := CurrComp;
      EditingSub := True;
      CurrComp := TComponent (sg.Objects [1, Row]);
    end;

    ///////////////////////////////////////////////////
    ////////// depending on the type, show up an editor
    case ppInfo.PropType^.Kind of

      tkInteger: ////////////////////////////////////////
      begin
        if ppInfo.PropType^.Name = 'TCursor' then
        begin
          ComboCursor.Text := GetPropValAsString (CurrComp, ppInfo);
          PlaceControl (ComboCursor);
        end else if ppInfo.PropType^.Name = 'TColor' then
        begin
          ComboColor.Tag := GetOrdProp (CurrComp, ppInfo);
          ComboColor.Text := GetPropValAsString (CurrComp, ppInfo);
          PlaceControl (ComboColor)
        end else
        begin
          EditNum.Text := GetPropValAsString (CurrComp, ppInfo);
          PlaceControl (EditNum);
          EditModified := False;
        end;
      end;

      tkChar: ////////////////////////////////////////////
      begin
        EditCh.Text := GetPropValAsString (CurrComp, ppInfo);
        PlaceControl (EditCh);
        EditModified := False;
      end;

      tkEnumeration: /////////////////////////////////////
      begin
        ComboEnum.Clear;
        {$IFDEF VER100}
        ListEnum (ppInfo.PropType^, ComboEnum.Items, False);
        {$ELSE} // Delphi 2
        ListEnum (ppInfo.PropType, ComboEnum.Items, False);
        {$ENDIF}
        ComboEnum.ItemIndex := ComboEnum.Items.IndexOf (
          GetPropValAsString (CurrComp, ppInfo));
        PlaceControl (ComboEnum);
      end;

      tkString, tkLString: //////////////////////////
      begin
        EditStr.Text := GetStrProp (
          CurrComp, ppInfo);
        PlaceControl (EditStr);
        EditModified := False;
      end;

      tkSet: ////////////////////////////////////////
      begin
        ListSet.Clear;
        ListEnum (
          {$IFDEF VER100}
          GetTypeData (ppInfo.PropType^).CompType^,
          {$ELSE} // Delphi 2
          GetTypeData (ppInfo.PropType).CompType,
          {$ENDIF}
          ListSet.Items, False);
        // select the "on" items
        for I := 0 to ListSet.Items.Count - 1 do
          ListSet.Selected [I] :=
            IsBitOn (GetOrdProp (CurrComp, ppINfo), I);
        PlaceControl (ListSet);
        ListSet.Height := ListSet.Height * 8;
      end;

      // tkClass: //// see double click...
    end;
  end;
end;

// create and show a dialog box a string list editor..
procedure TGridEditForm.EditStringList (Str: TStrings);
var
  F: TForm;
  I: Integer;
  Memo1: TMemo;
begin
  F := TForm.Create (Application);
  try
    F.Width := 250;
    F.Height := 300;
    // middle of the screen
    F.Left := Screen.Width div 2 - 125;
    F.Top := Screen.Height div 2 - 150;
    F.Caption := 'StringList Editor for ' + CurrProp.Name;
    F.BorderStyle := bsDialog;
    Memo1 := TMemo.Create (F);
    with Memo1 do
    begin
      Parent := F;
      Width := F.ClientWidth;
      Height := F.ClientHeight - 30;
      for I := 0 to Str.Count - 1 do
        Lines.Add (Str [I]);
    end;
    with TBitBtn.Create (F) do
    begin
      Parent := F;
      Width := F.ClientWidth div 2;
      Top := F.ClientHeight - 30;
      Height := 30;
      Kind := bkOK;
    end;
    with TBitBtn.Create (F) do
    begin
      Parent := F;
      Width := F.ClientWidth div 2;
      Left := F.ClientWidth div 2;
      Top := F.ClientHeight - 30;
      Height := 30;
      Kind := bkCancel;
    end;
    if F.ShowModal = mrOk then
    begin
      Str.Clear;
      for I := 0 to Memo1.Lines.Count - 1 do
        Str.Add (Memo1.Lines [I]);
    end;
  finally
    F.Free;
  end;
end;

procedure TGridEditForm.sgDataSelectCell(Sender: TObject; Col, Row: Longint;
  var CanSelect: Boolean);
var
  sg: TStringGrid;
  ptInfo: PTypeInfo;
begin
  sg := Sender as TStringGrid;
  // get the data and show it in the first line
  ptInfo := PTypeInfo (sg.Objects [0, Row] );
  sg.Cells [1, 0] := ptInfo.Name;
  sg.Objects [1, 0] := Pointer (ptInfo);
end;

procedure TGridEditForm.sgMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  sg: TStringGrid;
  ACol, ARow: Longint;
begin
  sg := Sender as TStringGrid;
  sg.MouseToCell (X, Y, ACol, ARow);
  if (ARow = 0) and (sg.Cells [1, 0] <> '') then
    ShowRttiDetail (PTypeInfo (sg.Objects [1, 0]));
end;

//////////////////////////////////////
///// menu items and UI //////////////
//////////////////////////////////////

procedure TGridEditForm.RefreshForms1Click(Sender: TObject);
begin
  UpdateFormsCombo;
end;

procedure TGridEditForm.RefreshComponents1Click(Sender: TObject);
begin
  UpdateCompsCombo;
end;

procedure TGridEditForm.About1Click(Sender: TObject);
begin
  // Show an about box
  MessageDlg (VersionDescription +
    #13+ VersionRelease +
    #13#13'Copyright Marco Cantù 1997',
    mtINformation, [mbOk], 0);
end;

procedure TGridEditForm.RefreshValues1Click(Sender: TObject);
begin
  UpdateProps;
end;

//////////////////////////////////
/////// special editors... ///////
//////////////////////////////////

////// edit string //////

procedure TGridEditForm.EditStrExit(Sender: TObject);
begin
  if EditModified then
    SetStrProp (CurrComp, CurrProp, EditStr.Text);
  RefreshOnExit (Sender);
end;

////////// edit num /////////////

procedure TGridEditForm.EditNumExit(Sender: TObject);
begin
  try
    if EditModified then
      SetOrdProp (CurrComp, CurrProp, StrToInt (EditNum.Text));
    RefreshOnExit (Sender);
  except
    on EConvertError do
    begin
      ShowMessage ('Not a number');
      EditNum.SetFocus;
    end;
  end;
end;

procedure TGridEditForm.EditNumKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9']) and not (Key = #8) then
    Key := #0;
end;

///////// combo color /////////

procedure TGridEditForm.ComboColorDblClick(Sender: TObject);
var
  Color: LongInt;
  ColName: string;
  nItem: Integer;
begin
  if not IdentToColor (ComboColor.Text, Color) then
    Color := TColor (ComboColor.Tag);
  ColorDialog1.Color := Color;
  if ColorDialog1.Execute then
  begin
    ComboColor.Tag := ColorDialog1.Color;
    ColName := ColorToString (ColorDialog1.Color);
    nItem := ComboColor.Items.IndexOf (ColName);
    if nItem >= 0 then
      ComboColor.ItemIndex := nItem
    else
      ComboColor.Text := ColName;
    ComboColorChange (ComboColor);
  end;
end;

procedure TGridEditForm.ComboColorChange(Sender: TObject);
var
  Color: LongInt;
begin
  if IdentToColor (ComboColor.Text, Color) then
    ComboColor.Tag := Color
  else
    Color := TColor (ComboColor.Tag);
  SetOrdProp (CurrComp, CurrProp, Color);
end;

///////// combo cursor ///////////

procedure TGridEditForm.ComboCursorChange(Sender: TObject);
begin
  SetOrdProp (CurrComp, CurrProp,
    StringToCursor (ComboCursor.Text));
end;

////////// combo enum /////////

procedure TGridEditForm.ComboEnumChange(Sender: TObject);
begin
  SetOrdProp (CurrComp, CurrProp,
    {$IFDEF VER100}
    GetEnumValue (CurrProp.PropType^, ComboEnum.Text));
    {$ELSE} // Delphi 2
    GetEnumValue (CurrProp.PropType, ComboEnum.Text));
    {$ENDIF}
end;

procedure TGridEditForm.ComboEnumDblClick(Sender: TObject);
begin
  with ComboEnum do
    if ItemIndex < Items.Count - 1 then
      ItemIndex := ItemIndex + 1
    else
      ItemIndex := 0;
  ComboEnumChange (ComboEnum);
end;

///////// edit ch //////////

procedure TGridEditForm.EditChExit(Sender: TObject);
var
  Ch: Char;
begin
  try
    if EditModified then
    begin
      if Length (EditCh.Text) = 1 then
        Ch := EditCh.Text [1]
      else if EditCh.Text [1] = '#' then
        Ch := Char (StrToInt (Copy (
          EditCh.Text, 2, Length (EditCh.Text) - 1)))
      else
        raise EConvertError.Create ('Error');
      SetOrdProp (CurrComp, CurrProp, Word (Ch));
    end;
    RefreshOnExit (Sender);
  except
    on EConvertError do
    begin
      ShowMessage ('Not a valid character');
      EditCh.SetFocus;
    end;
  end;
end;

////////// list set ///////////

procedure TGridEditForm.ListSetClick(Sender: TObject);
var
  Value: Word;
  I: Integer;
begin
  Value := 0;
  // update the value, scanning the list
  for I := 0 to ListSet.Items.Count - 1 do
    if ListSet.Selected [I] then
      Value := Value + Round (Power (2, I));
  SetOrdProp (CurrComp, CurrProp, Value);
end;

//// generic //////////

procedure TGridEditForm.RefreshOnExit(Sender: TObject);
begin
  sgProp.Cells [1, CurrRow] :=
    GetPropValAsString (CurrComp, CurrProp);
  (Sender as TWinControl).Hide;
  if EditingSub then
    CurrComp := RealComp;
end;

//////////// resizing /////////////////

procedure TGridEditForm.FormResize(Sender: TObject);
begin
  with cbForms do
    Width := self.ClientWidth - Left * 2;
  with cbComps do
    Width := self.ClientWidth - Left * 2;
  with sgProp do
    ColWidths [1] := ClientWidth - ColWidths [0] -
      GetSystemMetrics (sm_cxVScroll) - 2;
  with sgEvt do
    ColWidths [1] := ClientWidth - ColWidths [0] -
      GetSystemMetrics (sm_cxVScroll) - 2;
end;

procedure TGridEditForm.TopMost1Click(Sender: TObject);
begin
  TopMost1.Checked := not TopMost1.Checked;
  if TopMost1.Checked then
    FormStyle := fsStayOnTop
  else
    FormStyle := fsNormal;
end;

procedure TGridEditForm.sgPropDblClick(Sender: TObject);
begin
  if CurrProp <> nil then
  begin
    if CurrProp.PropType^.Name = 'TFont' then
    begin
      FontDialog1.Font.Assign (
        TFont (GetOrdProp (CurrComp, CurrProp)));
      if FontDialog1.Execute then
      begin
        TFont (GetOrdProp (CurrComp, CurrProp)).
          Assign (FontDialog1.Font);
        UpdateProps;
      end;
    end;

    // string list editor...
    if CurrProp.PropType^.Name = 'TStrings' then
      EditStringList (TStrings (
        GetOrdProp (CurrComp, CurrProp)));
  end;
end;

procedure TGridEditForm.Info1Click(Sender: TObject);
begin
  MessageDlg (VersionDescription + #13 +
    'Copyright Marco Cantù 1997'#13#13 +
    'Usage: Select form and component you are interested in'#13 +
    '(also the form is listed among its components), and see'#13 +
    'its published properties, its events, and some mode data.'#13#13 +
    'Clicking on the first line shows RTTI information for'#13 +
    'the last property you''ve selected.'#13#13 +
    'Clicking on a value activates its editor (if available).'#13 +
    'Editors include: numbers, strings, characters,'#13 +
    'enumarations, sets, cursors, colors (double-click),'#13 +
    'string lists (double click).',
    mtInformation, [mbOk], 0);
end;

procedure TGridEditForm.FormActivate(Sender: TObject);
begin
  UpdateFormsCombo;
end;

procedure TGridEditForm.EditChange(Sender: TObject);
begin
  EditModified := True;
end;

end.