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.
Screen Shot on download location
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.
Have fun,
Daniel Wischnewski,
Content Ace 
Sign Up
