delphi 组件用户自定义设计期工具|笨鱼技术网

As you know under delphi 6 there is DsgnIntf. unit. Instead of this unit DesignIntf and DesignEditors units came with delphi 6 and after.
Now to fix code first use DesignIntf and DesignEditors units instead of DsgnIntf.. and replase IformDesigner to IDesigner in frmDesignTimeEditor unit.After to do this you will get error.to correct this please replace Designer.form.Name to Designer.Root.Name. And Now You can compile these usefull toll on delphi 7.
here is the code of frmDesignTimeEditor.

Thank again to Daniel Wischnewski for that good companent.

unit frmDesignTimeEditor;

interface

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

type
// component editor for the TComponentStateRecorder class
TCSRDesignEditor = class(TDefaultEditor)
protected
public
    function GetVerb(Index: Integer): String; override;
    function GetVerbCount: Integer; override;
    procedure ExecuteVerb(Index: Integer); override;
end;

// property editor that lists all properties of a component at design-time
TPropertyNameEditor = class(TStringProperty)
public
procedure GetValues(Proc: TGetStrProc); override;
function GetAttributes: TPropertyAttributes; override;
end;

// property editor that lists all components at design-time
TComponentNameEditor = class(TStringProperty)
public
procedure GetValues(Proc: TGetStrProc); override;
function GetAttributes: TPropertyAttributes; override;
end;

TfrmCSRDesigner = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    edtRegKey: TEdit;
    Panel2: TPanel;
    btnOK: TBitBtn;
    trvCollections: TTreeView;
    Panel3: TPanel;
    lblComponent: TLabel;
    cmbComponent: TComboBox;
    grpProperty: TGroupBox;
    lblPropertyName: TLabel;
    cmbPropertyName: TComboBox;
    lblDefaultValue: TLabel;
    edtDefaultValue: TEdit;
    btnAddComponent: TButton;
    btnRemove: TButton;
    btnAddProperty: TButton;
    procedure btnOKClick(Sender: TObject);
    procedure trvCollectionsChange(Sender: TObject; Node: TTreeNode);
    procedure btnAddComponentClick(Sender: TObject);
    procedure cmbComponentChange(Sender: TObject);
    procedure edtRegKeyChange(Sender: TObject);
    procedure cmbPropertyNameChange(Sender: TObject);
    procedure edtDefaultValueChange(Sender: TObject);
    procedure btnAddPropertyClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
private
    FCSR: TComponentStateRecorder;
    FDesigner: IDesigner;
    procedure SetCSR(const Value: TComponentStateRecorder);
    procedure ShowProperties(Name: String);
    procedure UpdateForSelectedNode;
    procedure SetDesigner(const Value: IDesigner);
public
    property CSR: TComponentStateRecorder read FCSR write SetCSR;
    property Designer: IDesigner read FDesigner write SetDesigner;
end;

var
frmCSRDesigner: TfrmCSRDesigner;

procedure Register;

implementation

{$R *.DFM}

procedure Register;
begin
// register component
RegisterComponents('gate(n)etwork', [TComponentStateRecorder]);
// register property editors (they will provide drop-down lists to the OI)
RegisterPropertyEditor(
TypeInfo(String), TSavedComponent, 'ComponentName', TComponentNameEditor
);
RegisterPropertyEditor(
TypeInfo(String), TSavedProperty, 'PropertyName', TPropertyNameEditor
);
// register component editor
RegisterComponentEditor(TComponentStateRecorder, TCSRDesignEditor);
end;

{ TCSRDesignEditor }

procedure TCSRDesignEditor.ExecuteVerb(Index: Integer);
begin
with TfrmCSRDesigner.Create(Application) do
try
    Designer := Self.Designer;
    CSR := TComponentStateRecorder(Component);
    ShowModal;
finally
    Free;
end;
end;

function TCSRDesignEditor.GetVerb(Index: Integer): String;
begin
if Index = 0 then
Result := 'Edit all recorded Properties...'
else
Result := '';
end;

function TCSRDesignEditor.GetVerbCount: Integer;
begin
Result := 1;
end;

{ TPropertyNameEditor }

function TPropertyNameEditor.GetAttributes: TPropertyAttributes;
begin
// the property editor will provide a sorted list of possible values
Result := [paValueList, paSortList];
end;

procedure TPropertyNameEditor.GetValues(Proc: TGetStrProc);
var
I, Count: Integer;
PropInfos: PPropList;
TmpComponent: TComponent;
SC: TSavedComponent;
begin
// check property type
if not (GetComponent(0) is TSavedProperty) then
Exit;
// get TSavedComponent (parent object)
SC := TSavedProperties(
TSavedProperty(GetComponent(0)).Collection
).SavedComponent;
// find the corresponding component

if SC.ComponentName = Designer.Root.Name then
     TmpComponent := Designer.Root
   else
    TmpComponent := Designer.GetComponent(SC.ComponentName);

// quit if component was not found
if TmpComponent = nil then
    Exit;
// determine the property count
Count := GetPropList(TmpComponent.ClassInfo, [
    tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
    tkLString
], nil);
// reserve memory needed for property informations
GetMem(PropInfos, Count * SizeOf(PPropInfo));
try
    // load property list
    GetPropList(TmpComponent.ClassInfo, [
      tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
      tkLString
    ], PropInfos);
    // save to object inspector list
    for I := 0 to Pred(Count) do
      Proc(PropInfos^[I]^.Name);
finally
    // free resources
    FreeMem(PropInfos);
end;
end;

{ TComponentNameEditor }

function TComponentNameEditor.GetAttributes: TPropertyAttributes;
begin
// the property editor will provide a sorted list of possible values
Result := [paValueList, paSortList];
end;

procedure TComponentNameEditor.GetValues(Proc: TGetStrProc);
var
I: Integer;
begin
// return name of form
if Designer.Root.Name <> '' then
    Proc(Designer.Root.Name);
// return names of all components
for I := 0 to Pred(Designer.root.ComponentCount) do
    if Designer.root.Components[I].Name <> '' then
      Proc(Designer.root.Components[I].Name);
end;

{ TfrmCSRDesigner }

procedure TfrmCSRDesigner.btnAddComponentClick(Sender: TObject);
var
Node: TTreeNode;
SC: TSavedComponent;
begin
SC := CSR.SavedComponents.Add;
Node := trvCollections.Items.AddChild(nil, SC.DisplayName);
trvCollections.Selected := Node;
Node.Data := SC;
UpdateForSelectedNode;
Designer.Modified;
end;

procedure TfrmCSRDesigner.btnAddPropertyClick(Sender: TObject);
var
Node: TTreeNode;
SP: TSavedProperty;
begin
if trvCollections.Selected = nil then
    Exit;
if trvCollections.Selected.Data = nil then
    Exit;
if not (TObject(trvCollections.Selected.Data) is TSavedComponent) then
    Exit;
SP := TSavedComponent(trvCollections.Selected.Data).SavedProperties.Add;
Node :=
    trvCollections.Items.AddChild(trvCollections.Selected, SP.DisplayName);
Node.Data := SP;
trvCollections.Selected := Node;
UpdateForSelectedNode;
Designer.Modified;
end;

procedure TfrmCSRDesigner.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
end;

procedure TfrmCSRDesigner.btnRemoveClick(Sender: TObject);
begin
if trvCollections.Selected = nil then
    Exit;
if trvCollections.Selected.Data = nil then
    Exit;
if (TObject(trvCollections.Selected.Data) is TSavedComponent) then
begin
    TSavedComponent(trvCollections.Selected.Data).Collection.Delete(
      TSavedComponent(trvCollections.Selected.Data).Index
    );
    trvCollections.Items.Delete(trvCollections.Selected);
end;
if (TObject(trvCollections.Selected.Data) is TSavedProperty) then
begin
    TSavedProperty(trvCollections.Selected.Data).Collection.Delete(
      TSavedProperty(trvCollections.Selected.Data).Index
    );
    trvCollections.Items.Delete(trvCollections.Selected);
end;
Designer.Modified;
end;

procedure TfrmCSRDesigner.cmbComponentChange(Sender: TObject);
begin
if trvCollections.Selected = nil then
    Exit;
if trvCollections.Selected.Data = nil then
    Exit;
if not (TObject(trvCollections.Selected.Data) is TSavedComponent) then
    Exit;
TSavedComponent(trvCollections.Selected.Data).ComponentName :=
    cmbComponent.Text;
trvCollections.Selected.Text :=
    TSavedComponent(trvCollections.Selected.Data).DisplayName;
Designer.Modified;
end;

procedure TfrmCSRDesigner.cmbPropertyNameChange(Sender: TObject);
begin
if trvCollections.Selected = nil then
    Exit;
if trvCollections.Selected.Data = nil then
    Exit;
if not (TObject(trvCollections.Selected.Data) is TSavedProperty) then
    Exit;
TSavedProperty(trvCollections.Selected.Data).DefaultValue := '';
TSavedProperty(trvCollections.Selected.Data).PropertyName :=
    cmbPropertyName.Text;
trvCollections.Selected.Text :=
    TSavedProperty(trvCollections.Selected.Data).DisplayName;
edtDefaultValue.Text :=
    TSavedProperty(trvCollections.Selected.Data).DefaultValue;
Designer.Modified;
end;

procedure TfrmCSRDesigner.edtDefaultValueChange(Sender: TObject);
begin
if trvCollections.Selected = nil then
    Exit;
if trvCollections.Selected.Data = nil then
    Exit;
if not (TObject(trvCollections.Selected.Data) is TSavedProperty) then
    Exit;
TSavedProperty(trvCollections.Selected.Data).DefaultValue :=
    edtDefaultValue.Text;
Designer.Modified;
end;

procedure TfrmCSRDesigner.edtRegKeyChange(Sender: TObject);
begin
FCSR.RegistryKey := edtRegKey.Text;
Designer.Modified;
end;

procedure TfrmCSRDesigner.SetCSR(const Value: TComponentStateRecorder);
var
I, J: Integer;
SC: TSavedComponent;
SP: TSavedProperty;
SCNode, SPNode: TTreeNode;
begin
FCSR := Value;
// load registry key
edtRegKey.Text := FCSR.RegistryKey;
trvCollections.Items.Clear;
// parse all selected components
for I := 0 to Pred(FCSR.SavedComponents.Count) do
begin
    SC := FCSR.SavedComponents.Items[I];
    SCNode := trvCollections.Items.AddChild(nil, SC.DisplayName);
    SCNode.Data := SC;
    // parse all selected properties
    for J := 0 to Pred(SC.SavedProperties.Count) do
    begin
      SP := SC.SavedProperties.Items[J];
      SPNode := trvCollections.Items.AddChild(SCNode, SP.DisplayName);
      SPNode.Data := SP;
    end;
end;
// select the first item in the list
if trvCollections.Items.Count > 0 then
    trvCollections.Selected := trvCollections.Items.Item[0];
if Designer <> nil then
begin
    // return name of form
    if Designer.root.Name <> '' then
      cmbComponent.Items.Add(Designer.root.Name);
    // return names of all components
    for I := 0 to Pred(Designer.root.ComponentCount) do
      if Designer.root.Components[I].Name <> '' then
        cmbComponent.Items.Add(Designer.root.Components[I].Name);
end;
// show state of selection
UpdateForSelectedNode;
end;

type
TEnableStates = (esComponent, esProperty);
TEnableStateSet = set of TEnableStates;

procedure TfrmCSRDesigner.SetDesigner(const Value: IDesigner);
begin
FDesigner := Value;
end;

procedure TfrmCSRDesigner.ShowProperties(Name: String);
var
I, Count: Integer;
PropInfos: PPropList;
TmpComponent: TComponent;
begin
// clear list
cmbPropertyName.Clear;
// stop if no component name is provided
if Name = '' then
    Exit;
// get component
if CSR.Owner.Name = Name then
   TmpComponent := CSR.Owner
else
    TmpComponent := CSR.Owner.FindComponent(Name);
// stop if component was not found
if TmpComponent = nil then
    Exit;
// determine the property count
Count := GetPropList(TmpComponent.ClassInfo, [
    tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
    tkLString
], nil);
// reserve memory needed for property informations
GetMem(PropInfos, Count * SizeOf(PPropInfo));
try
    // load property list
    GetPropList(TmpComponent.ClassInfo, [
      tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
      tkLString
    ], PropInfos);
    // save to object inspector list
    for I := 0 to Pred(Count) do
      cmbPropertyName.Items.Add(PropInfos^[I]^.Name);
finally
    // free resources
    FreeMem(PropInfos);
end;
end;

procedure TfrmCSRDesigner.trvCollectionsChange(Sender: TObject;
Node: TTreeNode);
begin
UpdateForSelectedNode;
end;

procedure TfrmCSRDesigner.UpdateForSelectedNode;
var
CompName, PropertyName: String;
EnableStates: TEnableStateSet;
begin
EnableStates := [];
Name := '';
if trvCollections.Selected <> nil then
    if trvCollections.Selected.Data <> nil then
    begin
      if TObject(trvCollections.Selected.Data) is TSavedComponent then
      begin
        cmbComponent.Text :=
          TSavedComponent(trvCollections.Selected.Data).ComponentName;
        EnableStates := EnableStates + [esComponent];
        cmbPropertyName.Text := '';
        edtDefaultValue.Text := '';
        trvCollections.Selected.Text :=
          TSavedComponent(trvCollections.Selected.Data).DisplayName;
        CompName := '';
        PropertyName := '';
      end;
      if TObject(trvCollections.Selected.Data) is TSavedProperty then
      begin
        EnableStates := EnableStates + [esProperty];
        CompName :=
          TSavedProperties(TSavedProperty(
            trvCollections.Selected.Data
          ).Collection).SavedComponent.ComponentName;
        cmbComponent.Text := CompName;
        PropertyName :=
          TSavedProperty(trvCollections.Selected.Data).PropertyName;
        cmbPropertyName.Text := Name;
        edtDefaultValue.Text :=
          TSavedProperty(trvCollections.Selected.Data).DefaultValue;
        trvCollections.Selected.Text :=
          TSavedProperty(trvCollections.Selected.Data).DisplayName;
      end;
    end;
cmbComponent.Enabled := esComponent in EnableStates;
lblComponent.Enabled := esComponent in EnableStates;
btnAddProperty.Enabled := esComponent in EnableStates;
cmbPropertyName.Enabled := esProperty in EnableStates;
lblPropertyName.Enabled := esProperty in EnableStates;
edtDefaultValue.Enabled := esProperty in EnableStates;
lblDefaultValue.Enabled := esProperty in EnableStates;
grpProperty.Enabled := esProperty in EnableStates;
btnRemove.Enabled := EnableStates <> [];
ShowProperties(CompName);
cmbPropertyName.Text := PropertyName;
trvCollections.Update;
end;

end.