Component for Saving User Settings automatically (using Tools API)

Problem/Question/Abstract:

There are many routines every Delphi programmer does on an almost daily basis. One of these routines is writing and retrieving user settings to/from the Windows Registry. More and more applications "remember" some of our favorite settings, like form position and size.
For the programmer it is an rather boring and time-consuming part to save all these settings, but the user is almost expecting such basic functionality. The TComponentStateRecorder component will help you to achieve this functionality by simply adding it to your form at design-time.

Answer:

Note: The component provided with this article was developed using Borland Delphi 5. It should work with Borland Delphi 4, too. For newer version, some adoptions are required, as Borland has renamed some of the units.

This is going to be a rather complex article. You should be familiar with object oriented programming, as well as have some experience in component writing. If not, simply download the component and come back at a later time and re-read this article. Take a look at the "How-to" section.

The Principle

Our component allows the programmer to set the Registry Key, where the settings will be saved. All recorded data will be written at the set location. The value name will be created using the component name, a colon and the property name. The value will be saved as string.

Any component on the same form as the Component State Recorder is placed upon, con be chosen to be saved.

The following property types of any chose component can be saved. The value of all properties will be converted into their string representation. Following property types can be used:

tkInteger
tkInt64
tkFloat
tkEnumeration
tkSet
tkChar
tkString
tkLString

The Component State Recorder publishes the SavedComponents collection, where all components, whose values should be recorded, can be added to. Every item (TSavedComponent) of this collection publishes another collection. All recorded properties (TSavedProperty) are saved within this collection.

Planning the Component State Recorder

The Component State Recorder, will be visible at design-time only, therefore we will create a descendant auf the TComponent class. We will name the class TComponentStateRecorder. The Component State Recorder has a property for the Registry key, where all the data will be recorded. Our default setting will be: \Software\Your Software\Component State Recorder\ + the forms name (RegistryKey). Further we will publish a collection, where all recorded components are listed, named (TSavedComponents).

The Saved Components collection (TSavedComponents) is a descendent of the TCollection from the Classes unit. Basically, we do not have to create our own logic for such collections, however, we will have to override some methods and introduce the items property. The items property will give us access to each saved component individually.

The Saved Component item class (TSavedComponent) is a descendent of the TCollectionItem class from the Classes unit. We will publish two new properties. The first property (ComponentName) allows us to choose the component that will be controlled. The second property is, once again, a collection, giving access to each controlled property, individually.

The Saved Properties collection (TSavedProperties) is a descendent of the TCollection from the Classes unit, too. Same rules apply to this collection, as for TSavedComponents. We will give access to zero or more saved property items through the items property.

The Saved Property item class (TSavedProperty) is a descendent of the TCollectionItem class from the Classes unit. We will publish two new properties. The first property allows us to choose the components property to be saved, the second allows us to set a default value, if the registry has no settings saved.

Loading and Saving the States

Our Component State Recorder class defines the private method

procedure DoStates(Action: TRecorderAction);

This method will both, load and save the current component state from/to the Windows Registry. For the programmer we will create two wrapper methods for loading and saving, which both will call this method internally.

DoStates will open access to the registry. Then it will iterate through all components in its collections and every property within its collection. Each property value will be set/loaded separately. When loading a value that is not in the registry, the Component State Recorder will use the default value provided during design time.

The Component State Recorder will check first, if the component requested exists. If not, it will continue with the next component. Then it will check for each property separately and will load/save them, if they exist within the component.

Creating Property Editors

Writing Property Editors is a rather easy task. Delphi provides many descendants of the TPropertyEditor class, that actually provide the logic needed to create your own. For this component we will simply create two string editors. The first editor will allow us to choose for the SavedComponent property from a drop-down list of all components on the form. The second editor will do the same for the SavedProperty property of the TSavedProperty collection item.

Basically we do the same for both of them. First, we will override the GetAttributes function, allowing us to determine the behavior of the property editor. We tell the Object Inspector, to provide a drop-down list of sorted values.

Result := [paValueList, paSortList];

Second, we will override the GetValues function. The function takes on parameter, a pointer to a procedure allowing us to add a string for each item in the list, individually.

Depending on the property editor, we will either return a name list of all components on the form or a list of all properties of a specific component.

Creating a Component Dialog

Writing a component editor involves little more attention than creating a property editor, but it allows us to get done much faster when selecting component properties for automated backup. Delphi provides us the TDefaultEditor class for creating property editors. We will override three methods.

GetVerbCount: We will return 1, because we need only one menu item
GetVerb: Returns the name of the menu item (shown if the programmer right-clicks the component at design-time)
ExecuteVerb: Executed when the programmer clicks (one of) our menu item.

Within the ExecuteVerb method we will create a form and show it to the programmer. There he/she can easily editor our component.

The Component Editor Form

This part is not harder than the rest, but still, it is the most complex, because, we have to design the programmers interface and control the whole Component State Recorder.



With this done, we will need to fill in the code. The Component Dialog class, called by Delphi must pass along the Component State Recorder Component being edited, as well as the Designer interface.

Delphi will not know, if we change the component in the editor, we must therefore notify Delphi about such matters by calling the Designer.Modified; method. This will inform Delphi of any changes and ask the programmer to save the changes to file, if the project is closed!

The remainder is pretty straight forward. The Tree List View will show all managed components and their managed properties. Each item will hold an pointer to their related collection item in the Component State Recorder. This way we can easily modify it on demand.

Putting the Component State Recorder to Work

The Component State Recorder will not automatically load and save the states for us. You will have to call the ComponentStateRecorder1.LoadStates method during the FormCreate event and the ComponentStateRecorder1.SaveStates method during the FormDestroy event.

The Component State Recorder Source Code

unit ComponentStateRecovery;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TypInfo, DsgnIntf;

type
  TSavedProperty = class;
  TSavedComponent = class;
  TComponentStateRecorder = class;

  // single property that will be saved
  TSavedProperty = class(TCollectionItem)
  private
    // name of property to be saved
    FPropertyName: string;
    // default value if property does not exist
    FDefaultValue: string;
    procedure SetPropertyName(const Value: string);
    procedure SetDefaultValue(const Value: string);
    function GetRegistryValue: string;
    procedure SetRegistryValue(const Value: string);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(aCollection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property PropertyName: string read FPropertyName write SetPropertyName;
    property RegistryValue: string read GetRegistryValue write SetRegistryValue;
    property DefaultValue: string read FDefaultValue write SetDefaultValue;
  end;

  TSavedProperties = class(TCollection)
  private
    // owner of this collection
    FSavedComponent: TSavedComponent;
    function GetItem(Index: Integer): TSavedProperty;
    procedure SetItem(Index: Integer; const Value: TSavedProperty);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(aSavedComponent: TSavedComponent);
    function Add: TSavedProperty;
    property SavedComponent: TSavedComponent read FSavedComponent;
    property Items[Index: Integer]: TSavedProperty read GetItem write SetItem;
  published
  end;

  TSavedComponent = class(TCollectionItem)
  private
    // name of component to be saved
    FComponentName: string;
    // properties of 'this' component to be saved
    FSavedProperties: TSavedProperties;
    procedure SetSavedProperties(const Value: TSavedProperties);
    procedure SetComponentName(const Value: string);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property SavedProperties: TSavedProperties
      read FSavedProperties
      write SetSavedProperties;
    property ComponentName: string read FComponentName write SetComponentName;
  end;

  TSavedComponents = class(TCollection)
  private
    // owner of this collection
    FComponentStateRecorder: TComponentStateRecorder;
    function GetItem(Index: Integer): TSavedComponent;
    procedure SetItem(Index: Integer; const Value: TSavedComponent);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(aComponentStateRecorder: TComponentStateRecorder);
    function Add: TSavedComponent;
    property Items[Index: Integer]: TSavedComponent read GetItem write SetItem;
  published
  end;

  // action of the record (save to registry - or - load from registry)
  TRecorderAction = (raSave, raLoad);

  TComponentStateRecorder = class(TComponent)
  private
    // components of owner form to be saved
    FSavedComponents: TSavedComponents;
    // registry key - where form components will be saved
    FRegistryKey: string;
    procedure SetSavedComponents(const Value: TSavedComponents);
    procedure SetRegistryKey(const Value: string);
    procedure DoStates(Action: TRecorderAction);
  protected
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure SaveStates;
    procedure LoadStates;
  published
    property SavedComponents: TSavedComponents
      read FSavedComponents
      write SetSavedComponents;
    property RegistryKey: string read FRegistryKey write SetRegistryKey;
  end;

procedure Register;

implementation

uses
  Registry;

procedure Register;
begin
  // register component
  RegisterComponents('gate(n)etwork', [TComponentStateRecorder]);
end;

function GetPropertyAsString(
  Component: TComponent; PropInfo: PPropInfo
  ): string;
begin
  with PropInfo^ do
    case PropType^.Kind of
      tkInteger:
        // get integer value
        Result := IntToStr(GetOrdProp(Component, PropInfo));
      tkInt64:
        // get integer (64 bit) value
        Result := IntToStr(GetOrdProp(Component, PropInfo));
      tkFloat:
        // get float value
        Result := FloatToStr(GetFloatProp(Component, PropInfo));
      tkEnumeration:
        // get enumeration value
        Result := GetEnumProp(Component, PropInfo);
      tkSet:
        // get set value
        Result := GetSetProp(Component, PropInfo);
      tkChar:
        // get single character value
        Result := Chr(GetOrdProp(Component, PropInfo));
      tkString, tkLString:
        // get string value
        Result := GetStrProp(Component, PropInfo);
    else
      Result := '';
    end;
end;

procedure SetPropertyFromString(
  Component: TComponent; PropInfo: PPropInfo; Value: string
  );
begin
  try
    with PropInfo^ do
      case PropType^.Kind of
        tkInteger:
          // set integer value
          SetOrdProp(Component, PropInfo, StrToIntDef(
            Value, GetOrdProp(Component, PropInfo)
            ));
        tkInt64:
          // set integer (64 bit) value
          SetInt64Prop(Component, PropInfo, StrToIntDef(
            Value, GetInt64Prop(Component, PropInfo)
            ));
        tkFloat:
          // set float value
          SetFloatProp(Component, PropInfo, StrToFloat(Value));
        tkEnumeration:
          // set enumeration value
          SetEnumProp(Component, PropInfo, Value);
        tkSet:
          // set set value
          SetSetProp(Component, PropInfo, Value);
        tkChar:
          // set single character value
          SetOrdProp(Component, PropInfo, Ord(Value[1]));
        tkString, tkLString:
          // set string value
          SetStrProp(Component, PropInfo, Value);
      end;
  except
  end;
end;

{ TSavedProperty }

procedure TSavedProperty.Assign(Source: TPersistent);
begin
  if Source is TSavedProperty then
  begin
    // assign all local values
    FPropertyName := TSavedProperty(Source).FPropertyName;
    FDefaultValue := TSavedProperty(Source).FDefaultValue;
  end
  else
  begin
    inherited Assign(Source);
  end;
end;

constructor TSavedProperty.Create(aCollection: TCollection);
begin
  inherited Create(aCollection);
  // set default values
  FPropertyName := '';
  FDefaultValue := '';
end;

function TSavedProperty.GetDisplayName: string;
begin
  // return property name or components name
  if FPropertyName <> '' then
    Result := FPropertyName
  else
    Result := inherited GetDisplayName;
end;

function TSavedProperty.GetRegistryValue: string;
begin
  // the registry value is created by the component and property names
  Result :=
    TSavedProperties(Collection).FSavedComponent.ComponentName + ':' +
    FPropertyName;
end;

procedure TSavedProperty.SetDefaultValue(const Value: string);
begin
  FDefaultValue := Value;
end;

procedure TSavedProperty.SetPropertyName(const Value: string);
var
  PropInfo: PPropInfo;
  TmpComponent: TComponent;
  CSR: TComponentStateRecorder;
begin
  // set property name
  FPropertyName := Value;
  // set default value on-demand
  if FDefaultValue = '' then
  begin
    // get state recorder
    CSR := TSavedComponents(
      TSavedProperties(Collection).FSavedComponent.Collection
      ).FComponentStateRecorder;
    // at design-time only, load components current value as default
    if csDesigning in CSR.ComponentState then
    begin
      // load the named component (or form)
      if
        TSavedProperties(Collection).FSavedComponent.ComponentName =
        CSR.Owner.Name then
        TmpComponent := CSR.Owner
      else
        TmpComponent := CSR.Owner.FindComponent(
          TSavedProperties(Collection).FSavedComponent.ComponentName
          );
      // check whether component was found
      if TmpComponent <> nil then
      begin
        // get property information
        PropInfo := GetPropInfo(TmpComponent.ClassInfo, Value);
        // check whether property information where found
        if PropInfo <> nil then
          // load current property value
          FDefaultValue := GetPropertyAsString(
            TmpComponent, PropInfo
            );
      end;
    end;
  end;
end;

procedure TSavedProperty.SetRegistryValue(const Value: string);
begin
  // ignore
end;

{ TSavedProperties }

function TSavedProperties.Add: TSavedProperty;
begin
  Result := TSavedProperty(inherited Add);
end;

constructor TSavedProperties.Create(aSavedComponent: TSavedComponent);
begin
  inherited Create(TSavedProperty);
  FSavedComponent := aSavedComponent;
end;

function TSavedProperties.GetItem(Index: Integer): TSavedProperty;
begin
  Result := TSavedProperty(inherited GetItem(Index));
end;

function TSavedProperties.GetOwner: TPersistent;
begin
  Result := FSavedComponent;
end;

procedure TSavedProperties.SetItem(Index: Integer; const Value: TSavedProperty);
begin
  inherited SetItem(Index, Value);
end;

procedure TSavedProperties.Update(Item: TCollectionItem);
begin
  inherited;
  // nothing to do
end;

{ TSavedComponent }

procedure TSavedComponent.Assign(Source: TPersistent);
begin
  if Source is TSavedComponent then
  begin
    // load values from source
    FComponentName := TSavedComponent(Source).FComponentName;
    FSavedProperties.Assign(TSavedComponent(Source).SavedProperties);
  end
  else
  begin
    inherited Assign(Source);
  end;
end;

constructor TSavedComponent.Create(aCollection: TCollection);
begin
  inherited Create(aCollection);
  FSavedProperties := TSavedProperties.Create(Self);
end;

destructor TSavedComponent.Destroy;
begin
  if not (
    csDesigning in
    TSavedComponents(Collection).FComponentStateRecorder.ComponentState
    ) then
  begin
    // in desgin-time mode, the designer will free the objects for us
    FSavedProperties.Free;
    FSavedProperties := nil;
  end;
  inherited Destroy;
end;

function TSavedComponent.GetDisplayName: string;
begin
  if FComponentName <> '' then
    Result := FComponentName
  else
    Result := inherited GetDisplayName;
end;

procedure TSavedComponent.SetComponentName(const Value: string);
begin
  FComponentName := Value;
end;

procedure TSavedComponent.SetSavedProperties(const Value: TSavedProperties);
begin
  FSavedProperties.Assign(Value);
end;

{ TSavedComponents }

function TSavedComponents.Add: TSavedComponent;
begin
  Result := TSavedComponent(inherited Add);
end;

constructor TSavedComponents.Create(
  aComponentStateRecorder: TComponentStateRecorder
  );
begin
  inherited Create(TSavedComponent);
  FComponentStateRecorder := aComponentStateRecorder;
end;

function TSavedComponents.GetItem(Index: Integer): TSavedComponent;
begin
  Result := TSavedComponent(inherited GetItem(Index));
end;

function TSavedComponents.GetOwner: TPersistent;
begin
  Result := FComponentStateRecorder;
end;

procedure TSavedComponents.SetItem(
  Index: Integer; const Value: TSavedComponent
  );
begin
  inherited SetItem(Index, Value);
end;

procedure TSavedComponents.Update(Item: TCollectionItem);
begin
  inherited;
  // nothing to do
end;

{ TComponentStateRecorder }

constructor TComponentStateRecorder.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FSavedComponents := TSavedComponents.Create(Self);
  FRegistryKey :=
    '\Software\Your Software\Component State Recorder\' + TForm(aOwner).Name;
end;

destructor TComponentStateRecorder.Destroy;
begin
  FSavedComponents.Free;
  FSavedComponents := nil;
  inherited Destroy;
end;

procedure TComponentStateRecorder.DoStates(Action: TRecorderAction);
var
  RegistryOpened: Boolean;
  I, J: Integer;
  PropInfo: PPropInfo;
  TmpComponent: TComponent;
  SO: TSavedComponent;
  SP: TSavedProperty;
begin
  with TRegistry.Create do
  try
    // generally save settings for the user!
    RootKey := HKEY_CURRENT_USER;
    // open the registry key
    RegistryOpened := OpenKey(RegistryKey, True);
    try
      // iterate through all Components to be saved
      for I := 0 to Pred(FSavedComponents.Count) do
      begin
        // get current component
        SO := FSavedComponents.Items[I];
        // check, whether component name is set
        if SO.ComponentName = '' then
          Continue;
        // check, whether component is the owner form
        if SO.ComponentName = (Owner as TForm).Name then
          // use the owner forme
          TmpComponent := (Owner as TForm)
        else
          // find component on the owner form
          TmpComponent := (Owner as TForm).FindComponent(SO.ComponentName);
        // check component
        if TmpComponent = nil then
          // not found on form, check next in collection
          Continue;
        // iterate through all properties to be saved (of current Component)
        for J := 0 to Pred(SO.SavedProperties.Count) do
        begin
          // get current property
          SP := SO.SavedProperties.Items[J];
          // check, whether property name is set
          if SP.PropertyName = '' then
            Continue;
          // get property info pointer
          PropInfo := GetPropInfo(TmpComponent.ClassInfo, SP.PropertyName);
          // check for property
          if PropInfo = nil then
            // it does not exists, try next
            Continue;
          // registry access ?
          if RegistryOpened then
            // yes, save or load?
            if Action = raSave then
              // save
              WriteString(
                SP.RegistryValue, GetPropertyAsString(TmpComponent, PropInfo)
                )
            else
              {// load, does value exist? } if ValueExists(SP.RegistryValue) then
                // yes, load
                SetPropertyFromString(
                  TmpComponent, PropInfo, ReadString(SP.RegistryValue)
                  )
              else
                // no, get default
                SetPropertyFromString(TmpComponent, PropInfo, SP.DefaultValue)
            else
              // no registry access, in load mode?
              if Action = raLoad then
                // yes, load default
                SetPropertyFromString(TmpComponent, PropInfo, SP.DefaultValue);
        end;
      end;
    finally
      if RegistryOpened then
        CloseKey;
    end;
  finally
    Free;
  end;
end;

procedure TComponentStateRecorder.LoadStates;
begin
  DoStates(raLoad);
end;

procedure TComponentStateRecorder.SaveStates;
begin
  DoStates(raSave);
end;

procedure TComponentStateRecorder.SetRegistryKey(const Value: string);
begin
  if Value = '' then
    FRegistryKey :=
      '\Software\Your Software\Component State Recorder\' + TForm(Owner).Name
  else
    FRegistryKey := Value;
end;

procedure TComponentStateRecorder.SetSavedComponents(
  const Value: TSavedComponents
  );
begin
  FSavedComponents.Assign(Value);
end;

end.


The Property and Component Editors Source

unit frmDesignTimeEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ComCtrls, ComponentStateRecovery, DsgnIntf,
  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: IFormDesigner;
    procedure SetCSR(const Value: TComponentStateRecorder);
    procedure ShowProperties(Name: string);
    procedure UpdateForSelectedNode;
    procedure SetDesigner(const Value: IFormDesigner);
  public
    property CSR: TComponentStateRecorder read FCSR write SetCSR;
    property Designer: IFormDesigner 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.Form.Name then
    TmpComponent := Designer.Form
  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.Form.Name <> '' then
    Proc(Designer.Form.Name);
  // return names of all components
  for I := 0 to Pred(Designer.Form.ComponentCount) do
    if Designer.Form.Components[I].Name <> '' then
      Proc(Designer.Form.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.Form.Name <> '' then
      cmbComponent.Items.Add(Designer.Form.Name);
    // return names of all components
    for I := 0 to Pred(Designer.Form.ComponentCount) do
      if Designer.Form.Components[I].Name <> '' then
        cmbComponent.Items.Add(Designer.Form.Components[I].Name);
  end;
  // show state of selection
  UpdateForSelectedNode;
end;

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

procedure TfrmCSRDesigner.SetDesigner(const Value: IFormDesigner);
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.

Component Download: http://www.geocities.com/wischnewski.geo/articles/d3k/csr/