gridef.pas

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

        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