I am having a problem creating a lookup component.
I will try again ... put the images to facilitate ....
does not save the values of properties in the dfm ... so why, my properties are grouped in a class ... if they were "loose" would perform the setter method ...
my doubt is ... why not run?
I thank you ...
My class of properties
TLookupProperties = class(TPersistent)
private
FDataCharCase: TEditCharCase;
FOnLookupBeforeSearch: TNotifyEvent;
FDataSource: TDataSource;
FOnButtonClick: TNotifyEvent;
FDataTabela: string;
FOnExit: TNotifyEvent;
FDataCondicao: string;
FDataFieldDescricao: string;
FDataFieldCodigo: string;
FOnLookupValidate: TNotifyEvent;
FDataFieldID: String;
published
property OnLookupBeforeSearch: TNotifyEvent read FOnLookupBeforeSearch write FOnLookupBeforeSearch;
property OnLookupExit: TNotifyEvent read FOnExit write FOnExit;
property OnLookupButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
property OnLookupValidate: TNotifyEvent read FOnLookupValidate write FOnLookupValidate;
property DataSource: TDataSource read FDataSource write FDataSource;
property DataFieldID: String read FDataFieldID write FDataFieldID;
property DataFieldCodigo: string read FDataFieldCodigo write FDataFieldCodigo;
property DataFieldDescricao: string read FDataFieldDescricao write FDataFieldDescricao;
property Condicao: string read FDataCondicao write FDataCondicao;
property Tabela: string read FDataTabela write FDataTabela;
property CharCase: TEditCharCase read FDataCharCase write FDataCharCase;
end;
My component
TDBLookupFrame = class(TFrame)
PnlTotal: TPanel;
btnButton: TSpeedButton;
edtCodigo: TDBEdit;
lblDescricao: TDBText;
procedure edtCodigoExit(Sender: TObject);
procedure btnButtonClick(Sender: TObject);
procedure edtCodigoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure edtCodigoKeyPress(Sender: TObject; var Key: Char);
strict private
procedure SetarResult(AZerar: Boolean = False);
procedure Validar(Sender: TObject);
private
FLookupView: TLookupView;
FLookupProperties: TLookupProperties;
procedure SetLookupProperties(const Value: TLookupProperties);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property LookupProperties: TLookupProperties read FLookupProperties write SetLookupProperties;
end;
procedure register;
implementation
uses System.SysUtils;
{$R *.dfm}
procedure register;
begin
RegisterComponents('Hebran',[TDBLookupFrame]);
end;
procedure TDBLookupFrame.SetLookupProperties(const Value: TLookupProperties);
begin
FLookupProperties := Value;
edtCodigo.CharCase := FLookupProperties.CharCase;
FLookupView.Tabela := FLookupProperties.Tabela;
FLookupView.CondicaoAdicional := FLookupProperties.Condicao;
if Assigned(FLookupProperties.DataSource) then
begin
edtCodigo.DataSource := FLookupProperties.DataSource;
lblDescricao.DataSource := FLookupProperties.DataSource;
FLookupProperties.DataFieldDescricao := FLookupProperties.DataFieldCodigo;
lblDescricao.DataField := FLookupProperties.DataFieldDescricao;
end;
end;
constructor TDBLookupFrame.Create(AOwner: TComponent);
begin
inherited;
FLookupView := TLookupView.Create(Nil);
FLookupProperties := TLookupProperties.Create;
LookupProperties.Condicao := '';
LookupProperties.CharCase := ecNormal;
end;
Looking here (which is called while streaming the DFM into your component):
procedure TDBLookupFrame.SetLookupProperties(const Value: TLookupProperties);
begin
FLookupProperties := Value;
edtCodigo.CharCase := FLookupProperties.CharCase;
FLookupView.Tabela := FLookupProperties.Tabela;
FLookupView.CondicaoAdicional := FLookupProperties.Condicao;
if Assigned(FLookupProperties.DataSource) then
begin
edtCodigo.DataSource := FLookupProperties.DataSource;
lblDescricao.DataSource := FLookupProperties.DataSource;
FLookupProperties.DataFieldDescricao := FLookupProperties.DataFieldCodigo;
lblDescricao.DataField := FLookupProperties.DataFieldDescricao;
end;
end;
You are calling
FLookupProperties := Value;
Indeed, when relying on the IDE to auto-complete this for you, it too adds this. However, based on your situation, you should not be assigning a pointer - because you're now referencing the original instance of TLookupProperties and replacing the pointer to your copy. This also leaks memory, You already created FLookupProperties in the constructor, but can't reference that instance anymore because you've replaced the pointer.
You should instead be calling
FLookupProperties.Assign(Value);
This will ensure you create a full copy of the original value instead of just referencing the instance (which may or may not have been free'd after that point).
Your TLookupProperties should also be overriding TPersistent.Assign so that you can perform the appropriate copying of data from one instance to the other. Again, for any type of other TPersistent properties, don't use := because that just copies the pointer. Instead, use .Assign on them as well.
Try something more like this instead:
interface
uses
Classes, Forms, ...;
type
TDBLookupFrame = class;
TLookupProperties = class(TPersistent)
private
FOwner: TDBLookupFrame;
FDataCharCase: TEditCharCase;
FDataSource: TDataSource;
FDataTabela: string;
FDataCondicao: string;
FDataFieldDescricao: string;
FDataFieldCodigo: string;
FDataFieldID: String;
FOnChange: TNotifyEvent;
FOnButtonClick: TNotifyEvent;
FOnExit: TNotifyEvent;
FOnLookupBeforeSearch: TNotifyEvent;
FOnLookupValidate: TNotifyEvent;
procedure Changed;
procedure SetDataSource(const: Value: TDataSource);
procedure SetDataFieldID(const Value: String);
procedure SetDataFieldCodigo(const Value: string);
procedure SetDataFieldDescricao(const Valu: string);
procedure SetCondicao(const Value: string);
procedure SetTabela(const Value: string);
procedure SetCharCase(const Value: TEditCharCase);
public
constructor Create(AOwner: TDBLookupFrame);
procedure Assign(Source: TPeristent); override;
published
property DataSource: TDataSource read FDataSource write SetDataSource;
property DataFieldID: String read FDataFieldID write SetDataFieldID;
property DataFieldCodigo: string read FDataFieldCodigo write SetDataFieldCodigo;
property DataFieldDescricao: string read FDataFieldDescricao write SetDataFieldDescricao;
property Condicao: string read FDataCondicao write SetDataCondicao;
property Tabela: string read FDataTabela write SetDataTabela;
property CharCase: TEditCharCase read FDataCharCase write SetDataCharCase;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnLookupBeforeSearch: TNotifyEvent read FOnLookupBeforeSearch write FOnLookupBeforeSearch;
property OnLookupExit: TNotifyEvent read FOnExit write FOnExit;
property OnLookupButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
property OnLookupValidate: TNotifyEvent read FOnLookupValidate write FOnLookupValidate;
end;
TDBLookupFrame = class(TFrame)
PnlTotal: TPanel;
btnButton: TSpeedButton;
edtCodigo: TDBEdit;
lblDescricao: TDBText;
procedure edtCodigoExit(Sender: TObject);
procedure btnButtonClick(Sender: TObject);
procedure edtCodigoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure edtCodigoKeyPress(Sender: TObject; var Key: Char);
strict private
procedure SetarResult(AZerar: Boolean = False);
procedure Validar(Sender: TObject);
private
FLookupView: TLookupView;
FLookupProperties: TLookupProperties;
procedure LookupPropertiesChanged(Sender: TObject);
procedure SetLookupProperties(const Value: TLookupProperties);
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property LookupProperties: TLookupProperties read FLookupProperties write SetLookupProperties;
end;
procedure Register;
implementation
uses
System.SysUtils;
{$R *.dfm}
constructor TLookupProperties.Create(AOwner: TDBLookupFrame);
begin
inherited Create;
FOwner := AOwner;
FDataCondicao := '';
FDataCharCase := ecNormal;
end;
procedure TLookupProperties.Changed;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TLookupProperties.SetDataSource(const: Value: TDataSource);
begin
if FDataSource <> Value then
begin
if FDataSource <> nil then
FDataSource.RemoveFreeNotification(FOwner);
FDataSource := Value;
if FDataSource <> nil then
FDataSource.FreeNotification(FOwner);
Changed;
end;
end;
procedure TLookupProperties.SetDataFieldID(const Value: String);
begin
if FDataFieldID <> Value then
begin
FDataFieldID := Value;
Changed;
end;
end;
procedure TLookupProperties.SetDataFieldCodigo(const Value: string);
begin
if FDataFieldCodigo <> Value then
begin
FDataFieldCodigo := Value;
Changed;
end;
end;
procedure TLookupProperties.SetDataFieldDescricao(const Valu: string);
begin
if FDataFieldDescricao <> Value then
begin
FDataFieldDescricao := Value;
Changed;
end;
end;
procedure TLookupProperties.SetCondicao(const Value: string);
begin
if FDataCondicao <> Value then
begin
FDataCondicao := Value;
Changed;
end;
end;
procedure TLookupProperties.SetTabela(const Value: string);
begin
if FDataTabela <> Value then
begin
FDataTabela := Value;
Changed;
end;
end;
procedure TLookupProperties.SetCharCase(const Value: TEditCharCase);
begin
if FDataCharCase <> Value then
begin
FDataCharCase := Value;
Changed;
end;
end;
procedure TLookupProperties.Assign(Source: TPeristent);
var
Src: TLookupProperties;
begin
if Source is TLookupProperties then
begin
Src := TLookupProperties(Source);
FDataCharCase := Src.FDataCharCase;
SetDataSource(Src.FDataSource);
FDataTabela := Src.FDataTabela;
FDataCondicao := Src.FDataCondicao;
FDataFieldDescricao := Src.FDataFieldDescricao;
FDataFieldCodigo := Src.FDataFieldCodigo;
FDataFieldID := Src.FDataFieldID;
Changed;
end else
inherited;
end;
constructor TDBLookupFrame.Create(AOwner: TComponent);
begin
inherited;
FLookupView := TLookupView.Create(nil);
FLookupProperties := TLookupProperties.Create(Self);
end;
destructor TDBLookupFrame.Destroy;
begin
FLookupView.Free;
FLookupProperties.Free;
inherited;
end;
procedure TDBLookupFrame.Loaded;
begin
inherited;
LookupPropertiesChanged(nil);
end;
procedure TDBLookupFrame.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (AComponent = FLookupProperties.FDataSource) and (Operation = opRemove) then
FLookupProperties.FDataSource := nil;
end;
procedure TDBLookupFrame.LookupPropertiesChanged(Sender: TObject);
begin
if (ComponentState * [csLoading, csReading]) <> [] then
Exit;
edtCodigo.CharCase := FLookupProperties.CharCase;
FLookupView.Tabela := FLookupProperties.Tabela;
FLookupView.CondicaoAdicional := FLookupProperties.Condicao;
edtCodigo.DataSource := FLookupProperties.DataSource;
lblDescricao.DataSource := FLookupProperties.DataSource;
FLookupProperties.DataFieldDescricao := FLookupProperties.DataFieldCodigo;
lblDescricao.DataField := FLookupProperties.DataFieldDescricao;
end;
procedure TDBLookupFrame.SetLookupProperties(const Value: TLookupProperties);
begin
if FLookupProperties <> Value then
FLookupProperties.Assign(Value);
end;
procedure Register;
begin
RegisterComponents('Hebran', [TDBLookupFrame]);
end;
sorry but my example is simple ... the problem is that the class does not perform the set of property TProperties class, then, does not save the values in .dfm to put the dataSource and dataField properties directly on my component, it performs the set and writes to the dfm, however, when you open a form with my component, property values saved in the dfm are not found ... (error Ex: property datasource not found)
Related
I am creating a set of properties in a collection item. Each item has a different set of properties according to its type:
type
TMyProps = class(TPersistent)
private
Fcommom: boolean;
procedure Setcommom(const Value: boolean);
published
property commom: boolean read Fcommom write Setcommom;
end;
TMyPropsClass = class of TMyProps;
TFieldPropsFloat = class(TMyProps)
private
FDecimalplaces: integer;
procedure SetDecimalplaces(const Value: integer);
published
property Decimalplaces: integer read FDecimalplaces write SetDecimalplaces;
end;
TFieldPropsStr = class(TMyProps)
private
FLength: integer;
procedure SetLength(const Value: integer);
published
property Length: integer read FLength write SetLength;
end;
TMyCollection = class(TOwnedCollection)
end;
TMyItem = class(TCollectionItem)
private
FMyPropsClass: TMyPropsClass;
FMyProps: TMyProps;
procedure ReadMyProps(Reader: TReader);
procedure WriteMyProps(Writer: TWriter);
procedure RecreateMyProps;
procedure SetMyProps(const Value: TMyProps);
procedure SetMyPropsClass(const Value: TMyPropsClass);
protected
procedure DefineProperties(Filer: TFiler); override;
public
procedure AfterConstruction; override;
published
property MyPropsClass: TMyPropsClass read FMyPropsClass write SetMyPropsClass;
property MyProps: TMyProps read FMyProps write SetMyProps stored false;
end;
in 'TMyItem' an error occurs while loading properties written to '.dfm' file because 'MyProps' has not yet been built with 'MyPropsClass' properties that have not yet been loaded from '.dfm'
How to solve it? Is this the best approach?
Edit: Also, I'm trying to follow the tip Remy Lebeau gave me(comments bellow), but, I can't write in every item on the list.
///...
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyComponent]);
end;
procedure TMyItem.AfterConstruction;
begin
inherited;
FMyPropsClass := TFieldPropsStr;
RecreateMyProps;
end;
procedure TMyItem.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('MyProps', ReadMyProps, WriteMyProps, True);
end;
type
TReaderAccess = class(TReader);
TWriterAccess = class(TWriter);
procedure TMyItem.ReadMyProps(Reader: TReader);
begin
MyProps := TMyPropsClass(FindClass(Reader.ReadString)).Create;
Reader.CheckValue(vaCollection);
Reader.ReadListBegin;
while not Reader.EndOfList do
TReaderAccess(Reader).ReadProperty(MyProps);
Reader.ReadListEnd;
Reader.ReadListEnd;
end;
procedure TMyItem.RecreateMyProps;
begin
if FMyProps <> nil then
FMyProps.Free;
FMyProps := FMyPropsClass.Create;
end;
procedure TMyItem.SetMyProps(const Value: TMyProps);
begin
FMyProps := Value;
end;
procedure TMyItem.SetMyPropsClass(const Value: TMyPropsClass);
begin
if FMyPropsClass <> Value then
begin
FMyPropsClass := Value;
RecreateMyProps;
end;
end;
procedure TMyItem.WriteMyProps(Writer: TWriter);
begin
Writer.WriteString(MyProps.ClassName); //if comments this line, write fine
TWriterAccess(Writer).WriteValue(vaCollection);
Writer.WriteListBegin;
Writer.WriteProperties(MyProps);
Writer.WriteListEnd;
Writer.WriteListEnd;
end;
{ TMyProps }
procedure TMyProps.Setcommom(const Value: boolean);
begin
Fcommom := Value;
end;
{ TFieldPropsFloat }
procedure TFieldPropsFloat.SetDecimalplaces(const Value: integer);
begin
FDecimalplaces := Value;
end;
{ TFieldPropsStr }
procedure TFieldPropsStr.SetLength(const Value: integer);
begin
FLength := Value;
end;
{ TButton1 }
procedure TMyComponent.AfterConstruction;
begin
inherited;
FMyCollection := TMyCollection.Create(Self, TMyItem);
end;
procedure TMyComponent.SetMyCollection(const Value: TMyCollection);
begin
FMyCollection := Value;
end;
How correctly implements ReadMyProps and WriteMyProps procedures for each item of collection?
Mark the MyProps property as stored=false (or don't make it published at all) and then override the virtual DefineProperties() method to stream the MyProps data manually. See Storing and Loading Unpublished Properties: Overriding the DefineProperties Method in Embarcadero's DocWiki, and Streaming non-published TPersistent Properties – A Better Way on the Delphi Codesmith blog.
For example:
type
TMyItem = class(TCollectionItem)
private
procedure ReadMyProps(Reader: TReader);
procedure WriteMyProps(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
published
MyPropsClass: TMyPropsClass;
MyProps: TMyProps stored false;
end;
procedure TMyItem.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('MyProps', ReadMyProps, WriteMyProps, True);
end;
type
TReaderAccess = class(TReader);
TWriterAccess = class(TWriter);
procedure TMyItem.ReadMyProps(Reader: TReader);
begin
MyProps := TMyPropsClass(FindClass(Reader.ReadString)).Create;
Reader.CheckValue(vaCollection);
Reader.ReadListBegin;
while not Reader.EndOfList do
TReaderAccess(Reader).ReadProperty(MyProps);
Reader.ReadListEnd;
Reader.ReadListEnd;
end;
procedure TMyItem.WriteMyProps(Writer: TWriter);
begin
Writer.WriteString(MyProps.ClassName);
TWriterAccess(Writer).WriteValue(vaCollection);
Writer.WriteListBegin;
Writer.WriteProperties(MyProps);
Writer.WriteListEnd;
Writer.WriteListEnd;
end;
i have
...
TDispPitch = class
private
iLineSize: Integer;
iLineColor: TColor;
bDisplayAccent: Boolean;
bVisible: Boolean;
published
property LineSize : Integer read iLineSize write iLineSize;
...etc
end;
...
and i wanted this feature shown in Object Insepector to edit the settings.
i try adding
property DispPitch: TDispPitch read FDispPitch write FDispPitch. like
the DispPitch can be shown but i cannot see its properties. like LineSize, LineColor etc.
You must derive your class from TPersistent, or a descendant, in order to make it available in the Object Inspector:
TDispPitch = class(TPersistent)
private
...
published
property ...
...
end;
From Delphi Documentation:
TPersistent is the ancestor for all
objects that have assignment and
streaming capabilities.
The class needs to derive from TPersistent, and should implement the Assign() (or AssignTo()) method, as well as expose an OnChange event so the containing class can react to changes, eg:
type
TDispPitch = class(TPersistent)
private
iLineSize: Integer;
iLineColor: TColor;
bDisplayAccent: Boolean;
bVisible: Boolean;
FOnChange: TNotifyEvent;
procedure Changed;
procedure SetLineSize(Value : Integer);
procedure SetLineColor(Value: TColor);
procedure SetDisplayAccent(Value: Boolean);
procedure SetVisible(Value: Boolean);
public
procedure Assign(Source: TPersistent); override;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property LineSize : Integer read iLineSize write SetLineSize;
property LineColor: TColor read iLineColor write SetLineColor;
property DisplayAccent: Boolean read bDisplayAccent write SetDisplayAccent;
property Visible: Boolean read bVisible write SetVisible;
end;
procedure TDispPitch.Assign(Source: TPersistent);
var
LSource: TDispPitch;
begin
if Source is TDispPitch then
begin
LSource := TDispPitch(Source);
iLineSize := LSource.LineSize;
iLineColor := LSource.LineColor;
bDisplayAccent := LSource.DisplayAccent;
bVisible := LSource.Visible;
Changed;
end else
inherited;
end;
procedure TDispPitch.Changed;
begin
if FOnChange <> nil then FOnChange(Self);
end;
procedure TDispPitch.SetLineSize(Value : Integer);
begin
if iLineSize <> Value then
begin
iLineSize := Value;
Changed;
end;
end;
procedure TDispPitch.SetLineColor(Value: TColor);
begin
if iLineColor <> Value then
begin
iLineColor := Value;
Changed;
end;
end;
procedure TDispPitch.SetDisplayAccent(Value: Boolean);
begin
if bDisplayAccent <> Value then
begin
bDisplayAccent := Value;
Changed;
end;
end;
procedure TDispPitch.SetVisible(Value: Boolean);
begin
if bVisible <> Value then
begin
bVisible := Value;
Changed;
end;
end;
Then you use it like this:
type
TSomeOtherClass = class(...)
private
FDispPitch: TDispPitch;
procedure DispPitchChanged(Sender: TObject);
procedure SetDispPitch(Value: TDispPitch);
public
constructor Create; override;
destructor Destroy; override;
published
property DispPitch: TDispPitch read FDispPitch write SetDispPitch;
end;
constructor TSomeOtherClass.Create;
begin
inherited;
FDispPitch := TDispPitch.Create;
end;
destructor TSomeOtherClass.Destroy;
begin
FDispPitch.Free;
inherited;
end;
procedure TSomeOtherClass.DispPitchChanged(Sender: TObject);
begin
... use new FDispPitch values as needed...
end;
procedure TSomeOtherClass.SetDispPitch(Value: TDispPitch);
begin
FDispPitch.Assign(Value);
end;
I'm getting very confused about how to write out properties from a TComponent that has a TPersistent field. For example I have:
TChildObj = class( TPersistent )
PRIVATE
FVisible: boolean;
FColor: TColor;
PUBLIC
PUBLISHED
property Visible : boolean
read FVisible
write FVisible;
property Color : TColor
read FColor
write FColor;
end;
TTest = class( TComponent )
constructor Create( AOwner : TComponent ); override;
destructor Destroy; override;
private
FChildObj : TChildObj;
FOne: integer;
published
property One : integer
read FOne
write FOne;
property ChildObj : TChildObj
read FChildObj;
end;
When I use the following writer code:
procedure TForm1.Button5Click(Sender: TObject);
var
MS : TMemoryStream;
SS : TStringStream;
Test : TTest;
begin
Test := TTest.Create( Self );
MS := TMemoryStream.Create;
SS := TStringStream.Create;
try
MS.WriteComponent( Test );
MS.Position := 0;
ObjectBinaryToText( MS, SS );
SS.SaveToFile( 'c:\scratch\test.txt' );
finally
MS.Free;
SS.Free;
end;
end;
I get only the following:
object TTest
One = 0
end
i.e the TPersistent TChildObj is missing.
This article on component seriealization states "A Component will stream by default any property of type TPersistent that is not a TComponent. Our TPersistent property is streamed just like a component, and it may have other TPersistent properties that will get streamed." however when I step into System.Classes, at around line 12950 (XE3) there is the test:
if (PropInfo^.GetProc <> nil) and
((PropInfo^.SetProc <> nil) or
((PropInfo^.PropType^.Kind = tkClass) and
(TObject(GetOrdProp(Instance, PropInfo)) is TComponent) and
(csSubComponent in TComponent(GetOrdProp(Instance, PropInfo)).ComponentStyle))) then
which seems to indicate that only components and sub-components are serialised. If I make TChildObj descend from TComponent (and give it a name) I get its name appearing in the written file (but still no properties).
What I really dont understand is that TControl (a component) has the Font property (TPersistent) and this gets streamed out fine when you write a TLabel for example.
Or is this something to do with default properties?
Any help appreciated.
Look more closely at the list of requirements when the RTL is deciding if it needs to stream a TPersistent property:
if (PropInfo^.GetProc <> nil) and
((PropInfo^.SetProc <> nil) or
((PropInfo^.PropType^.Kind = tkClass) and
(TObject(GetOrdProp(Instance, PropInfo)) is TComponent) and
(csSubComponent in TComponent(GetOrdProp(Instance, PropInfo)).ComponentStyle))) then
Your ChildObj property is a read-only property, so it does not satisfy the PropInfo^.SetProc <> nil requirement, and it is not a TComponent-derived sub-component, so it does not satisfy the is is TComponent and csSubComponent requirements. That is why your property is missing from the DFM.
The simpliest solution is to make your ChildObj property be read/write instead of read-only (don't use TComponent unless you have to, which you don't in this situation).
You are also missing a destructor in TTest to free the TChildObj object. And for good measure, you should give TChildObj an OnChange event that TTest can assign a handler to, so it can react to changes to the TChildObj sub-properties.
Try this:
type
TChildObj = class(TPersistent)
private
FVisible : Boolean;
FColor : TColor;
FOnChange : TNotifyEvent;
procedure Changed;
procedure SetVisible(Value : Boolean);
procedure SetColor(Value : TColor);
public
procedure Assign(Source : TPersistent); override;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
published
property Visible : Boolean read FVisible write SetVisible;
property Color : TColor read FColor write SetColor;
end;
TTest = class(TComponent)
private
FChildObj : TChildObj;
FOne : integer;
procedure ChildObjChanged(Sender : TObject);
procedure SetChildObj(Value : TChildObj);
protected
procedure Loaded; override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property One : integer read FOne write FOne;
property ChildObj : TChildObj read FChildObj write SetChildObj;
end;
.
procedure TChildObj.Assign(Source: TPersistent);
begin
if Source is TChildObj then
begin
FVisible := TChildObj(Source).Visible;
FColor := TChildObj(Source).Color;
Changed;
end else
inherited;
end;
procedure TChildObj.Changed;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TChildObj.SetVisible(Value : Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
Changed;
end;
end;
procedure TChildObj.SetColor(Value : TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Changed;
end;
end;
constructor TTest.Create(AOwner : TComponent);
begin
inherited;
FChildObj := TChildObj.Create;
FChildObj.OnChange := ChildObjChanged;
end;
destructor TTest.Destroy;
begin
FChildObj.Free;
inherited;
end;
procedure TTest.ChildObjChanged(Sender : TObject);
begin
if csLoading in ComponentState then Exit;
// use ChildObj values as needed...
end;
procedure TTest.Loaded;
begin
inherited;
ChildObjChanged(nil);
end;
procedure TTest.SetChildObj(Value : TChildObj);
begin
if FChildObj <> Value then
FChildObj.Assign(Value);
end;
If you go the TComponent approach, then try this instead:
type
TChildObj = class(TComponent)
private
FVisible : Boolean;
FColor : TColor;
FOnChange : TNotifyEvent;
procedure Changed;
procedure SetVisible(Value : Boolean);
procedure SetColor(Value : TColor);
public
procedure Assign(Source : TPersistent); override;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
published
property Visible : Boolean read FVisible write SetVisible;
property Color : TColor read FColor write SetColor;
end;
TTest = class(TComponent)
private
FChildObj : TChildObj;
FOne : integer;
procedure ChildObjChanged(Sender : TObject);
procedure SetChildObj(Value : TChildObj);
protected
procedure Loaded; override;
public
constructor Create(AOwner : TComponent); override;
published
property One : integer read FOne write FOne;
property ChildObj : TChildObj read FChildObj write SetChildObj;
end;
.
procedure TChildObj.Assign(Source: TPersistent);
begin
if Source is TChildObj then
begin
FVisible := TChildObj(Source).Visible;
FColor := TChildObj(Source).Color;
Changed;
end else
inherited;
end;
procedure TChildObj.Changed;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TChildObj.SetVisible(Value : Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
Changed;
end;
end;
procedure TChildObj.SetColor(Value : TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Changed;
end;
end;
constructor TTest.Create(AOwner : TComponent);
begin
inherited;
FChildObj := TChildObj.Create(Self);
FChildObj.SetSubComponent(True);
FChildObj.OnChange := ChildObjChanged;
end;
procedure TTest.ChildObjChanged(Sender : TObject);
begin
if csLoading in ComponentState then Exit;
// use ChildObj values as needed...
end;
procedure TTest.Loaded;
begin
inherited;
ChildObjChanged(nil);
end;
procedure TTest.SetChildObj(Value : TChildObj);
begin
if FChildObj <> Value then
FChildObj.Assign(Value);
end;
I need to know the basics behind making a component produce and manage sub-components. I originally tried this by creating a TCollection, and tried to put a name on each TCollectionItem. But I learned it's not that easy as I had hoped.
So now I am going to start this project from scratch again, and I'd like to get it right this time. These sub-components are not visual components, and should not have any display or window, just based off of TComponent. The main component holding these sub-components will also be based off of TComponent. So nothing here is visual at all, and I don't want a little icon on my form (in design time) for each of these sub-components.
I would like to be able to maintain and manage these sub-components in a collection-like fashion. The important thing is that these sub-components should be created, named and added to the form source, just like menu items are for example. This is the whole point of the idea in the first place, if they cannot be named, then this whole idea is kaput.
Oh, another important thing: the main component being the parent of all the sub-components needs to be able to save these sub-components to the DFM file.
EXAMPLE:
Instead of accessing one of these sub items like:
MyForm.MyItems[1].DoSomething();
I would instead like to do something like:
MyForm.MyItem2.DoSomething();
So I do not have to rely on knowing the ID of each sub item.
EDIT:
I felt it a little necessary to include my original code so it can be seen how the original collection works. Here's just the server side collection and collection item stripped from the full unit:
// Command Collections
// Goal: Allow entering pre-set commands with unique Name and ID
// Each command has its own event which is triggered when command is received
// TODO: Name each collection item as a named component in owner form
//Determines how commands are displayed in collection editor in design-time
TJDCmdDisplay = (cdName, cdID, cdCaption, cdIDName, cdIDCaption);
TJDScktSvrCmdEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
const Data: TStrings) of object;
TSvrCommands = class(TCollection)
private
fOwner: TPersistent;
fOnUnknownCommand: TJDScktSvrCmdEvent;
fDisplay: TJDCmdDisplay;
function GetItem(Index: Integer): TSvrCommand;
procedure SetItem(Index: Integer; Value: TSvrCommand);
procedure SetDisplay(const Value: TJDCmdDisplay);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TPersistent);
destructor Destroy;
procedure DoCommand(const Socket: TJDServerClientSocket;
const Cmd: Integer; const Data: TStrings);
function Add: TSvrCommand;
property Items[Index: Integer]: TSvrCommand read GetItem write SetItem;
published
property Display: TJDCmdDisplay read fDisplay write SetDisplay;
property OnUnknownCommand: TJDScktSvrCmdEvent
read fOnUnknownCommand write fOnUnknownCommand;
end;
TSvrCommand = class(TCollectionItem)
private
fID: Integer;
fOnCommand: TJDScktSvrCmdEvent;
fName: String;
fParamCount: Integer;
fCollection: TSvrCommands;
fCaption: String;
procedure SetID(Value: Integer);
procedure SetName(Value: String);
procedure SetCaption(const Value: String);
protected
function GetDisplayName: String; override;
public
procedure Assign(Source: TPersistent); override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property ID: Integer read fID write SetID;
property Name: String read fName write SetName;
property Caption: String read fCaption write SetCaption;
property ParamCount: Integer read fParamCount write fParamCount;
property OnCommand: TJDScktSvrCmdEvent read fOnCommand write fOnCommand;
end;
////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////
{ TSvrCommands }
function TSvrCommands.Add: TSvrCommand;
begin
Result:= inherited Add as TSvrCommand;
end;
constructor TSvrCommands.Create(AOwner: TPersistent);
begin
inherited Create(TSvrCommand);
Self.fOwner:= AOwner;
end;
destructor TSvrCommands.Destroy;
begin
inherited Destroy;
end;
procedure TSvrCommands.DoCommand(const Socket: TJDServerClientSocket;
const Cmd: Integer; const Data: TStrings);
var
X: Integer;
C: TSvrCommand;
F: Bool;
begin
F:= False;
for X:= 0 to Self.Count - 1 do begin
C:= GetItem(X);
if C.ID = Cmd then begin
F:= True;
try
if assigned(C.fOnCommand) then
C.fOnCommand(Self, Socket, Data);
except
on e: exception do begin
raise Exception.Create(
'Failed to execute command '+IntToStr(Cmd)+': '+#10+e.Message);
end;
end;
Break;
end;
end;
if not F then begin
//Command not found
end;
end;
function TSvrCommands.GetItem(Index: Integer): TSvrCommand;
begin
Result:= TSvrCommand(inherited GetItem(Index));
end;
function TSvrCommands.GetOwner: TPersistent;
begin
Result:= fOwner;
end;
procedure TSvrCommands.SetDisplay(const Value: TJDCmdDisplay);
begin
fDisplay := Value;
end;
procedure TSvrCommands.SetItem(Index: Integer; Value: TSvrCommand);
begin
inherited SetItem(Index, Value);
end;
{ TSvrCommand }
procedure TSvrCommand.Assign(Source: TPersistent);
begin
inherited;
end;
constructor TSvrCommand.Create(Collection: TCollection);
begin
inherited Create(Collection);
fCollection:= TSvrCommands(Collection);
end;
destructor TSvrCommand.Destroy;
begin
inherited Destroy;
end;
function TSvrCommand.GetDisplayName: String;
begin
case Self.fCollection.fDisplay of
cdName: begin
Result:= fName;
end;
cdID: begin
Result:= '['+IntToStr(fID)+']';
end;
cdCaption: begin
Result:= fCaption;
end;
cdIDName: begin
Result:= '['+IntToStr(fID)+'] '+fName;
end;
cdIDCaption: begin
Result:= '['+IntToStr(fID)+'] '+fCaption;
end;
end;
end;
procedure TSvrCommand.SetCaption(const Value: String);
begin
fCaption := Value;
end;
procedure TSvrCommand.SetID(Value: Integer);
begin
fID:= Value;
end;
procedure TSvrCommand.SetName(Value: String);
begin
fName:= Value;
end;
This Thread helped me creating something as we discussed yesterday. I took the package posted there and modified it a bit. Here is the source:
TestComponents.pas
unit TestComponents;
interface
uses
Classes;
type
TParentComponent = class;
TChildComponent = class(TComponent)
private
FParent: TParentComponent;
procedure SetParent(const Value: TParentComponent);
protected
procedure SetParentComponent(AParent: TComponent); override;
public
destructor Destroy; override;
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
property Parent: TParentComponent read FParent write SetParent;
end;
TParentComponent = class(TComponent)
private
FChilds: TList;
protected
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Childs: TList read FChilds;
end;
implementation
{ TChildComponent }
destructor TChildComponent.Destroy;
begin
Parent := nil;
inherited;
end;
function TChildComponent.GetParentComponent: TComponent;
begin
Result := FParent;
end;
function TChildComponent.HasParent: Boolean;
begin
Result := Assigned(FParent);
end;
procedure TChildComponent.SetParent(const Value: TParentComponent);
begin
if FParent <> Value then
begin
if Assigned(FParent) then
FParent.FChilds.Remove(Self);
FParent := Value;
if Assigned(FParent) then
FParent.FChilds.Add(Self);
end;
end;
procedure TChildComponent.SetParentComponent(AParent: TComponent);
begin
if AParent is TParentComponent then
SetParent(AParent as TParentComponent);
end;
{ TParentComponent }
constructor TParentComponent.Create(AOwner: TComponent);
begin
inherited;
FChilds := TList.Create;
end;
destructor TParentComponent.Destroy;
var
I: Integer;
begin
for I := 0 to FChilds.Count - 1 do
FChilds[0].Free;
FChilds.Free;
inherited;
end;
procedure TParentComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
i: Integer;
begin
for i := 0 to FChilds.Count - 1 do
Proc(TComponent(FChilds[i]));
end;
end.
TestComponentsReg.pas
unit TestComponentsReg;
interface
uses
Classes,
DesignEditors,
DesignIntf,
TestComponents;
type
TParentComponentEditor = class(TComponentEditor)
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
procedure Register;
implementation
uses
ColnEdit;
type
TChildComponentCollectionItem = class(TCollectionItem)
private
FChildComponent: TChildComponent;
function GetName: string;
procedure SetName(const Value: string);
protected
property ChildComponent: TChildComponent read FChildComponent write FChildComponent;
function GetDisplayName: string; override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Name: string read GetName write SetName;
end;
TChildComponentCollection = class(TOwnedCollection)
private
FDesigner: IDesigner;
public
property Designer: IDesigner read FDesigner write FDesigner;
end;
procedure Register;
begin
RegisterClass(TChildComponent);
RegisterNoIcon([TChildComponent]);
RegisterComponents('Test', [TParentComponent]);
RegisterComponentEditor(TParentComponent, TParentComponentEditor);
end;
{ TParentComponentEditor }
procedure TParentComponentEditor.ExecuteVerb(Index: Integer);
var
LCollection: TChildComponentCollection;
i: Integer;
begin
LCollection := TChildComponentCollection.Create(Component, TChildComponentCollectionItem);
LCollection.Designer := Designer;
for i := 0 to TParentComponent(Component).Childs.Count - 1 do
with TChildComponentCollectionItem.Create(nil) do
begin
ChildComponent := TChildComponent(TParentComponent(Component).Childs[i]);
Collection := LCollection;
end;
ShowCollectionEditorClass(Designer, TCollectionEditor, Component, LCollection, 'Childs');
end;
function TParentComponentEditor.GetVerb(Index: Integer): string;
begin
Result := 'Edit Childs...';
end;
function TParentComponentEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
{ TChildComponentCollectionItem }
constructor TChildComponentCollectionItem.Create(Collection: TCollection);
begin
inherited;
if Assigned(Collection) then
begin
FChildComponent := TChildComponent.Create(TComponent(TOwnedCollection(Collection).Owner).Owner);
FChildComponent.Name := TChildComponentCollection(Collection).Designer.UniqueName(TChildComponent.ClassName);
FChildComponent.Parent := TParentComponent(TComponent(TOwnedCollection(Collection).Owner));
end;
end;
destructor TChildComponentCollectionItem.Destroy;
begin
FChildComponent.Free;
inherited;
end;
function TChildComponentCollectionItem.GetDisplayName: string;
begin
Result := FChildComponent.Name;
end;
function TChildComponentCollectionItem.GetName: string;
begin
Result := FChildComponent.Name;
end;
procedure TChildComponentCollectionItem.SetName(const Value: string);
begin
FChildComponent.Name := Value;
end;
end.
The most important thing is the RegisterNoIcon which prevents showing the component on the form when you create it. The overridden methods in TChildComponent are causing them to be nested inside the TParentComponent.
Edit: I added a temporary collection to edit the items in the built-in TCollectionEditor instead of having to write an own one. The only disadvantage is that the TChildComponentCollectionItem has to publish every property that TChildComponent has published to be able to edit them inside the OI.
Use the TComponent.SetSubComponent routine:
type
TComponent1 = class(TComponent)
private
FSubComponent: TComponent;
procedure SetSubComponent(Value: TComponent);
public
constructor Create(AOwner: TComponent); override;
published
property SubComponent: TComponent read FSubComponent write SetSubComponent;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TComponent1]);
end;
{ TComponent1 }
constructor TComponent1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSubComponent := TComponent.Create(Self); // Nót AOwner as owner here !!
FSubComponent.Name := 'MyName';
FSubComponent.SetSubComponent(True);
end;
procedure TComponent1.SetSubComponent(Value: TComponent);
begin
FSubComponent.Assign(Value);
end;
I now understand this sub component would be part of a collection item. In that case: no difference, use this method.
Implement TCollectionItem.GetDisplayName to "name" the collection items.
And concerning the collection: when this is a published property, the collection will automatically be named as the property name.
Be careful to implement GetOwner when you create properties of TPersistent.
i have
...
TDispPitch = class
private
iLineSize: Integer;
iLineColor: TColor;
bDisplayAccent: Boolean;
bVisible: Boolean;
published
property LineSize : Integer read iLineSize write iLineSize;
...etc
end;
...
and i wanted this feature shown in Object Insepector to edit the settings.
i try adding
property DispPitch: TDispPitch read FDispPitch write FDispPitch. like
the DispPitch can be shown but i cannot see its properties. like LineSize, LineColor etc.
You must derive your class from TPersistent, or a descendant, in order to make it available in the Object Inspector:
TDispPitch = class(TPersistent)
private
...
published
property ...
...
end;
From Delphi Documentation:
TPersistent is the ancestor for all
objects that have assignment and
streaming capabilities.
The class needs to derive from TPersistent, and should implement the Assign() (or AssignTo()) method, as well as expose an OnChange event so the containing class can react to changes, eg:
type
TDispPitch = class(TPersistent)
private
iLineSize: Integer;
iLineColor: TColor;
bDisplayAccent: Boolean;
bVisible: Boolean;
FOnChange: TNotifyEvent;
procedure Changed;
procedure SetLineSize(Value : Integer);
procedure SetLineColor(Value: TColor);
procedure SetDisplayAccent(Value: Boolean);
procedure SetVisible(Value: Boolean);
public
procedure Assign(Source: TPersistent); override;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property LineSize : Integer read iLineSize write SetLineSize;
property LineColor: TColor read iLineColor write SetLineColor;
property DisplayAccent: Boolean read bDisplayAccent write SetDisplayAccent;
property Visible: Boolean read bVisible write SetVisible;
end;
procedure TDispPitch.Assign(Source: TPersistent);
var
LSource: TDispPitch;
begin
if Source is TDispPitch then
begin
LSource := TDispPitch(Source);
iLineSize := LSource.LineSize;
iLineColor := LSource.LineColor;
bDisplayAccent := LSource.DisplayAccent;
bVisible := LSource.Visible;
Changed;
end else
inherited;
end;
procedure TDispPitch.Changed;
begin
if FOnChange <> nil then FOnChange(Self);
end;
procedure TDispPitch.SetLineSize(Value : Integer);
begin
if iLineSize <> Value then
begin
iLineSize := Value;
Changed;
end;
end;
procedure TDispPitch.SetLineColor(Value: TColor);
begin
if iLineColor <> Value then
begin
iLineColor := Value;
Changed;
end;
end;
procedure TDispPitch.SetDisplayAccent(Value: Boolean);
begin
if bDisplayAccent <> Value then
begin
bDisplayAccent := Value;
Changed;
end;
end;
procedure TDispPitch.SetVisible(Value: Boolean);
begin
if bVisible <> Value then
begin
bVisible := Value;
Changed;
end;
end;
Then you use it like this:
type
TSomeOtherClass = class(...)
private
FDispPitch: TDispPitch;
procedure DispPitchChanged(Sender: TObject);
procedure SetDispPitch(Value: TDispPitch);
public
constructor Create; override;
destructor Destroy; override;
published
property DispPitch: TDispPitch read FDispPitch write SetDispPitch;
end;
constructor TSomeOtherClass.Create;
begin
inherited;
FDispPitch := TDispPitch.Create;
end;
destructor TSomeOtherClass.Destroy;
begin
FDispPitch.Free;
inherited;
end;
procedure TSomeOtherClass.DispPitchChanged(Sender: TObject);
begin
... use new FDispPitch values as needed...
end;
procedure TSomeOtherClass.SetDispPitch(Value: TDispPitch);
begin
FDispPitch.Assign(Value);
end;