Was trying the same way as for the good old VCL TTreeNode. Ok, there is no TTreeNode and there is no method to add treenodes to the tree, instead i have to manually create TTreeViewItem instances and set it's parent property to a TTreeView instance. Now, TTreeViewItem has a data property but it's type is TValue.
How to handle this type?
I tried the following:
type
TMaster = class(TDevice)
...
end;
...
mstitem := TTreeViewItem.create(self);
mstitem.parent := TreeView1;
mstitem.data := TMaster.Create(i, 'master'+ inttostr(i));
...
procedure TForm1.TreeView1Click(Sender: TObject);
var
obj: TObject;
begin
selectednode := TTreeView1.Selected;
obj := TDevice(selectednode.Data.AsObject); //Invalid typecast
if obj is TDevice then
showmessage( TDevice(obj).DevName );
end;
TFmxObject.SetData method is empty virtual stub that has to be overriden in descendant classes. You cannot use TreeViewItem.Data the way you use it, because Data actually contains TTreeViewItem.Name property.
You would have to create your own descendant TTreeViewItem class and use it instead of default one
TMyTreeViewItem = class(TTreeViewItem)
protected
fData: TValue;
function GetData: TValue; override;
procedure SetData(const Value: TValue); override;
end;
function TMyTreeViewItem.GetData: TValue;
begin
Result := fData;
end;
procedure TMyTreeViewItem.SetData(const Value: TValue);
begin
fData := Value;
end;
Related
I have a set of components, that share some global variables to control common properties, e.g. style features.
These are currently accessed at run-time via a global class, e.g. MyCompsSettings().SomeProperty.
I thought it might be useful to allow users to configure some of these properties at design-time, so I converted the global class to a component, and because these properties need to be shared between MyCompsSettings() and instances of my TMyCompsSettings component(s), I used global vars to store the state, e.g.
type
TMyCompsSettings = class(TComponent)
private
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
var
gBackgroundColor: TColor;
gTitleText: string;
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
Result := gBackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
gBackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
Result := gTitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
gTitleText := v;
end;
However, I overlooked that the IDE will also maintain the var states, so when I:
Add a TMyCompsSettings component to a form
Set MyCompsSettings1.TitleText to 'ABC' in the object inspector
Open a different project
Add a TMyCompsSettings component to a form
-> MyCompsSettings1.TitleText is already 'ABC'!
Obvious of course, but I didn't consider that, and it breaks my whole model.
Is there a correct way to do this? e.g. Fields at design-time, vars at run-time, e.g.
type
TMyCompsSettings = class(TComponent)
private
FAuthoritative: Boolean; // Set to true for first instance, which will be MyCompsSettings()
FBackgroundColor: TColor;
FTitleText: string;
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FBackgroundColor
else
Result := MyCompsSettings().BackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FBackgroundColor := v
else
MyCompsSettings().BackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FTitleText
else
Result := MyCompsSettings().TitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FTitleText := v
else
MyCompsSettings().TitleText := v;
end;
As the IDE is a process, global variables in the process will remain in the process.
If you want to be able to track the settings between different projects in the IDE (which, if they're in a project group, could both have forms open at the same time) then you will need to find a way of tracking them.
Probably the simplest way is to have the settings held in an object - there can be a global object loaded in an initialization section and freed in a finalization section. Your form based TComponents can check if they are in design mode or not and if they are in design mode then they create a new separate copy of the object, if not they connect to the global instance of the object.
Other components that then access those settings will all use the global object - to ensure that the contents of the object match the design time version you would need to overwrite the global object with any form loaded version. You can do this in the TComponent's Loaded routine.
This code is unchecked, but should give you an outline of how it might work.
implementation
type
TMySettings = class(TPersistent) // so you can .Assign
protected
FOwner: TPersistent;
function GetOwner(): TPersistent; override;
public
constructor Create(AOwner: TPersistent); reintroduce;
property
Owner: TPersistent read GetOwner();
end;
TMySettingsComponent = class(TComponent)
protected
procedure Loaded(); override;
public
destructor Destroy(); override;
procedure AfterConstruction(); override;
end;
implementation
var
gpMySettings: TMySettings;
constructor TMySettings.Create(AOwner: TPersistent);
begin
Self.FOwner:=AOwner;
inherited Create();
end;
function TMySettins.GetOwner(): TPersistent;
begin
Result:=Self.FOwner;
end;
destructor TMySettingsComponent.Destroy;
begin
if(Self.FSettings.Owner = Self) then
FreeAndNIl(Self.FSettings);
inherited;
end;
procedure TMySettingsComponent.AfterConstruction();
begin
// our ComponentState will not yet be set
if( (Self.Owner <> nil) And
(csDesigning in Self.Owner.ComponentState) ) then
Self.FSettings:=TMySettings.Create(Self)
else
Self.FSettings:=gpMySettings;
inherited;
end;
procedure TMySettingsComponent.Loaded;
begin
if( (Self.FMySettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FMySettings);
end;
initialization
gpMySettings:=TMySettings.Create(nil);
finalization
FreeAndNIl(gpMySettings);
You would also want to ensure that in your TMySettingsComponent you update the global object when the user is changing the properties. This could be as simple as:
procedure TMyComponentSettings.SetBackgroundColour(FNewValue: TColor);
begin
if(Self.FSettings.FBkColour<>FNewValue) then
begin
Self.FSettings.FBkColour:=FNewValue;
if( (Self.FSettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FSettings);
// -- or use gpMySettings.FBkColour:=FNewValue;
end;
end;
I have a collection published in a component and I would like to be able to choose a collection item in the object inspector without using the method of saving the item's index.
I have already published the property of type to item (TCollectionItem), but in the object inspector it appears as a subcomponent with no option to choose another one. I registered an editor so that it could be possible to display the list of items, but it gives an error when clicking on the item dropbox. Below is an illustrative excerpt of the problem:
TMyCollection = class(TCollection)
end;
TMyCollectionItem = class(TCollectionItem)
end;
TMycomponent = class(TComponent)
published
property MyColection: TMyCollection;
property MyChosedItem: TCollectionItem; //< this need to be a list of TCollectionItem
end;
Bellow the Property Editor
type
TMyItemProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValueList(List: TStrings); virtual;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
end;
function TMyItemProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paSortList, paMultiSelect];
end;
procedure TMyItemProperty.GetValueList(List: TStrings);
var
Item: TMyCollectionItem;
Items: TMyCollection;
I: Integer;
begin
Items := (GetComponent(0) as TMyComponent).MyColection;
if Items <> nil then
for I := 0 to Items.Count-1 do
List.Add(Items.Items[I].GetNamePath); // Is this the problem ?
end;
procedure TMyItemProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
Values: TStringList;
begin
Values := TStringList.Create;
try
GetValueList(Values);
for I := 0 to Values.Count - 1 do
Proc(Values[I]);
finally
Values.Free;
end;
end;
procedure TMyItemProperty.SetValue(const Value: string);
begin
inherited SetValue(Value);
end;
when i open the property dropbox appear a error:"Invalid TypeCast".
How do I correctly implement the property editor for this property?
I would like to copy generic object but its type can only be obtained by the "class of" construct at runtime as the source object type may be different (TItem or TSpecificItem etc.):
type
TItem = class
//...
procedure Assign(Source: TItem);virtual; abstract; //edit
end;
TSpecificItem = class(TItem)
//...
end;
TEvenMoreSpecificItem = class(TSpecificItem)
//...
end;
TItemClass = class of TItem;
TItemContainer = class
FItems: TObjectList<TItem>; //edit
procedure Assign(Source: TObject); //edit
function GetItem(Index: Integer): TItem; inline; //edit
procedure SetItem(Index: Integer; Item: TItem); inline; //edit
function Count: Integer; //edit;
function ItemClass: TItemClass; virtual; abstract;
property Items[Index: Integer]: TItem read GetItem write SetItem; //edit
end;
TItemContainer<T: TItem> = class(TItemContainer)
//...
function GetItem(Index: Integer): T; inline; //edit
procedure SetItem(Index: Integer; Item: T); inline; //edit
function ItemClass: TItemClass; override;
property Items[Index: Integer]: T read GetItem write SetItem; default; //edit
end;
//start of edit
function TItemContainer.Count: Integer;
begin
Result := FItems.Count;
end;
function TItemContainer.GetItem(Index: Integer): TItem;
begin
Result := FItems[Index];
end;
procedure TItemContainer.SetItem(Index: Integer; Item: TItem);
begin
FItems[Index].Assign(Item);
end;
procedure TItemContainer.Assign(Source: TObject);
var
I: Integer;
Item: TItem;
Cls: TClass;
begin
if Source is TItemContainer then
begin
FItems.Clear;
for I := 0 to TItemContainer(Source).Count - 1 do
begin
Item := TItemContainer(Source).Items[I];
Cls := Item.ClassType;
Item := TItemClass(Cls).Create;
Item.Assign(TItemContainer(Source).Items[I]);
FItems.Add(Item);
end;
end;
end;
function TItemContainer<T>.GetItem(Index: Integer): T;
begin
Result := T(inherited GetItem(Index));
end;
procedure TItemContainer<T>.SetItem(Index: Integer; Item: T);
begin
inherited SetItem(Index, Item);
end;
//end of edit
function TItemContainer<T>.ItemClass: TItemClass;
begin
Result := TItemClass(GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType);
end;
function CopyGenericObject(Source: TItemContainer): TItemContainer;
var
Cls: TItemClass;
begin
Cls := Source.ItemClass;
Result := TItemContainer<Cls>.Create; // compiler reports error "incompatible types"
Result.Assign(Source);
end;
// edit:
procedure DoCopy;
var
Source: TItemContainer<TEvenMoreSpecificItem>;
Dest: TItemContainer;
begin
Source := TItemContainer<TEvenMoreSpecificItem>.Create; // for example
//add some items to Source
Dest := CopyGenericObject(Source);
//use the result somewhere
end;
I must Use Delphi XE.
I've found
http://docwiki.embarcadero.com/RADStudio/XE6/en/Overview_of_Generics
Dynamic instantiation
Dynamic instantiation at run time is not supported.
Is it what I want to do?
If I understand well, what you are looking for is to implement a routine that will create an instance of a class of the same type as a given source. This can be done like this :
type
TItemContainerclass = class of TItemContainer;
function CopyGenericObject(Source: TItemContainer): TItemContainer;
begin
Result := TItemContainerclass(Source.ClassType).Create;
end;
Also, you can simplify the ItemClass routine to
function TItemContainer<T>.ItemClass: TItemClass;
begin
Result := T;
end;
Note that this will only create a new instance and not a copy of the source, but since your code doesn't show any attempt to copy the object and only create a new instance, I presumed this is your intended result.
Note : This works in Delphi 10, I don't have access to XE to test it.
The line
Cls := Source.ItemClass;
will create the TItemClass instance at run time only. For Generics, the compiler needs to know the type at compile time. Without knowing it, the compiler can not generate the binary code which implements your specific TItemContainer<Cls>. Or, said in other words, Cls must not be a variable, it has to be a specific class type, known at compile time.
So for example these will compile:
Result := TItemContainer<TSpecificItem>.Create;
or
Result := TItemContainer<TEvenMoreSpecificItem>.Create;
but not this
Result := TItemContainer</* type will be known later */>.Create;
because the compiler is not able to come back later and complete the binary application code based on the actual type of Cls.
You can make CopyGenericObject function as a method of your generic object instead of stand-alone function:
TItemContainer<T: TItem> = class(TItemContainer)
...
function Copy: TItemContainer<T>;
end;
In this case, it "knows" at compile-time, what class to create just because there are now several of them (one for each Instantiated type) after compiler did its work, each making copy of itself.
There is one more trick which may be useful in your case: how to copy various objects. For example, you have common class TAnimal and its descendants: TCat and TDog. You store them in TItemContainer, that's the whole point of inheritance that you can do it and treat them generally. Now, you want to implement creating a copy of this container and you don't know at compile time, which elements will be dogs and which will be cats. Standart method is to define abstract function Copy in TAnimal:
TAnimal = class
public
...
function Copy: TAnimal; virtual; abstract;
end;
and then implement it in each descendant, so then you can copy your TItemContainer like this:
function TItemContainer<T>.Copy: TItemContainer<T>;
var i: T;
begin
Result:=TItemContainer<T>.Create;
for i in Items do
//I don't know exact structure of your container,
//maybe that's more like
// for j:=0 to Count-1 do begin
// i:=Items[j];
//but I hope it's obvious what happens here
Result.Add(i.copy as T);
end;
So if you have container of cats, then i.copy will return TAnimal (but actually a cat) which will be cast to TCat at last. It works but a bit ugly.
In delphi I came up with better solution: make this copy a constructor, not a function:
TAnimal = class
public
...
constructor Copy(source: TAnimal); virtual;
end;
In that case copying your container is like this:
function TItemContainer<T>.Copy: TItemContainer<T>;
var i,j: T;
begin
Result:=TItemContainer<T>.Create;
for i in Items do
Result.Add(T.Copy(i));
end;
no extra casting which is good. What's more, you can for example derive your classes from TPersistent and implement Assign procedure everywhere you need (very useful thing) and then once and for all write a copy constructor:
TAnimal = class(TPersistent)
public
constructor Copy(source: TPersistent); //or maybe source: TAnimal
end;
//implementation
constructor TAnimal.Copy(source: TPersistent);
begin
Create;
Assign(source);
end;
I want to write a program that works on a hierarchically organized tree data structure.
I need to have a root node and then be able to add child nodes and to move these node across the complete tree.
Is there a data structure in Delphi I can use for my algorithms and then later simply "copy" it to the GUI using a TTreeview component?
I suppose I need such a class:
type
TMyElement = class(...)
ElementName: String;
...
ChildElementList: TMyElementList;
HasChildElement: Boolean;
...
end;
At the dots, there will be more fields and routines specific for the element. How to build up this class? And how can I conveniently add these elements to a TreeView, using the ElementName field as caption for the tree nodes?
So, you have two questions:
How to build up this class?
Well, not yet focusing on the viewing-in-a-tree-view-ability, you could descent your class from TObjectList. Doing so, every element is capable of holding more of these object lists = elements. This approach is for example used for TMenuItem too.
And how can I conveniently add these elements to a TreeView, using the ElementName field as caption for the tree nodes?
You could add an AssignTo method to the class so that you can "assign" the root node to the TreeView.
Here you have an example implementation of the whole class. Add own properties as needed.
type
TElement = class(TObjectList)
private
FName: String;
FParent: TElement;
function GetItem(Index: Integer): TElement;
function GetLevel: Integer;
procedure SetItem(Index: Integer; Value: TElement);
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
function Add(AElement: TElement): Integer;
procedure AssignTo(Dest: TPersistent);
constructor Create; overload;
constructor Create(AName: String); overload;
constructor Create(AParent: TElement); overload;
constructor Create(AParent: TElement; AName: String); overload;
destructor Destroy; override;
function HasChilds: Boolean;
procedure Insert(Index: Integer; AElement: TObject);
property Items[Index: Integer]: TElement read GetItem write SetItem;
default;
property Level: Integer read GetLevel;
property Name: String read FName write FName;
end;
{ TElement }
function TElement.Add(AElement: TElement): Integer;
begin
if AElement = nil then
Result := -1
else
Result := inherited Add(AElement);
end;
procedure TElement.AssignTo(Dest: TPersistent);
var
Nodes: TTreeNodes;
Node: TTreeNode;
I: Integer;
begin
if Dest is TTreeView then
AssignTo(TTreeView(Dest).Items)
else if Dest is TTreeNodes then
begin
Nodes := TTreeNodes(Dest);
Nodes.BeginUpdate;
Nodes.Clear;
for I := 0 to Count - 1 do
begin
Node := Nodes.AddNode(nil, nil, Items[I].Name, Items[I], naAdd);
Items[I].AssignTo(Node);
end;
Nodes.EndUpdate;
end
else if Dest is TTreeNode then
begin
Node := TTreeNode(Dest);
Nodes := Node.Owner;
for I := 0 to Count - 1 do
Items[I].AssignTo(
Nodes.AddNode(nil, Node, Items[I].Name, Items[I], naAddChild));
end;
end;
constructor TElement.Create;
begin
Create(nil, '');
end;
constructor TElement.Create(AName: String);
begin
Create(nil, AName);
end;
constructor TElement.Create(AParent: TElement);
begin
Create(AParent, '');
end;
constructor TElement.Create(AParent: TElement; AName: String);
begin
inherited Create(True);
FName := AName;
if AParent <> nil then
AParent.Add(Self);
end;
destructor TElement.Destroy;
begin
if FParent <> nil then
FParent.Extract(Self);
inherited Destroy;
end;
function TElement.GetItem(Index: Integer): TElement;
begin
Result := TElement(inherited Items[Index]);
end;
function TElement.GetLevel: Integer;
begin
if FParent = nil then
Result := 0
else
Result := FParent.Level + 1;
end;
function TElement.HasChilds: Boolean;
begin
Result := Count > 0;
end;
procedure TElement.Insert(Index: Integer; AElement: TObject);
begin
if AElement <> nil then
inherited Insert(Index, AElement);
end;
procedure TElement.Notify(Ptr: Pointer; Action: TListNotification);
begin
inherited Notify(Ptr, Action);
case Action of
lnAdded:
TElement(Ptr).FParent := Self;
lnExtracted,
lnDeleted:
TElement(Ptr).FParent := nil;
end;
end;
procedure TElement.SetItem(Index: Integer; Value: TElement);
begin
inherited Items[Index] := Value;
end;
Example usage:
procedure TForm2.FormCreate(Sender: TObject);
begin
FRoot := TElement.Create;
TElement.Create(FRoot, '1');
TElement.Create(FRoot, '2');
TElement.Create(FRoot[1], '2.1');
TElement.Create(FRoot[1], '2.2');
TElement.Create(FRoot[1][0], '2.1.1');
TElement.Create(FRoot[1][0][0], '2.1.1.1');
TElement.Create(FRoot[1][0][0], '2.1.1.2');
TElement.Create(FRoot[1], '2.3');
TElement.Create(FRoot, '3');
TElement.Create(FRoot, '4');
TElement.Create(FRoot[3], '4.1');
FRoot.AssignTo(TreeView1);
end;
Filling a TTreeView at runtime is great fun!
Google 'rmtreenonview'. It is a single unit which implements a non-visual TTreeView-like class--most of the methods and properties are fully compatible with TTreeView.
rmtreenonview is quick and lightweight...we use it for manipulating a bunch of tree-structured data, but write the results to a grid control for display. But, you could copy results to a TTReeView just as easily.
Oh, and it also has hash-based tree searching capability and a couple other additons.
Lets say I have a Treeview, and it contains items with Object pointers. How can I determine from the selected item what the Object is, so I can access it?
Here is a basic example of some classes and code to give an idea:
Note: TChildObject1 and TChildObject2 inherit from TMyObject.
type
TMyObject = class
private
FName: string;
public
property Name: string read FName write FName;
constructor Create(aName: string);
end;
type
TChildObject1 = class(TMyObject)
private
FSomeString: string;
public
property SomeString: string read FSomeString write FSomeString;
constructor Create(aName: string);
destructor Destroy; override;
end;
type
TChildObject2 = class(TMyObject)
private
FSomeInteger: integer;
public
property SomeInteger: integer read FSomeInteger write FSomeInteger;
constructor Create(aName: string);
destructor Destroy; override;
end;
Lets say they were created and added to a TTreeview like so:
procedure NewChild1(aTreeView: TTreeView; aName: string);
var
Obj: TChildObject1;
begin
Obj := TChildObject1.Create(aName);
try
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
finally
Obj.Free;
end;
end;
procedure NewChild2(aTreeView: TTreeView; aName: string);
var
Obj: TChildObject2;
begin
Obj := TChildObject2.Create(aName);
try
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
finally
Obj.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// add the items to the tree
NewChild1(TreeView1, 'Child Object 1');
NewChild2(TreeView1, 'Child Object 2');
end;
Now, when I select a Node in the Treeview, how can I determine which Object class the pointer leads to? I tried this, which is not working:
Note: This does not error, but it does not return the correct value (ie, does not pick up the correct object)
procedure TForm1.TreeView1Click(Sender: TObject);
var
Obj: TMyObject;
begin
if TreeView1.Selected <> nil then
begin
Obj := TMyObject(TreeView1.Selected.Data);
if Obj is TChildObject1 then
begin
Edit1.Text := 'this node is a child1 object';
end else
if Obj is TChildObject2 then
begin
Edit1.Text := 'and this node is child 2 object';
end;
end;
end;
I could do it something like below, but I don't think is the right way, it means a lot of checking, declaring, assigning etc.
procedure TForm1.TreeView1Click(Sender: TObject);
var
ChildObj1: TChildObject1;
ChildObj2: TChildObject2;
begin
if TreeView1.Selected <> nil then
begin
if TreeView1.Selected.Text = 'Child Object 1' then
begin
ChildObj1 := TreeView1.Selected.Data;
Edit1.Text := ChildObj1.SomeString;
end else
if TreeView1.Selected.Text = 'Child Object 2' then
begin
ChildObj2 := TreeView1.Selected.Data;
Edit1.Text := IntToStr(ChildObj2.SomeInteger);
end;
end;
end;
Tips and advice appreciated.
The main problem is which you are freeing the memory of the object that you are adding to the treeview. So the data of the nodes points to a invalid location.
To assign the objects to a node use a code like this
Obj := TChildObject1.Create(aName);
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
and when you need dispose the data you can call the Free method for each node.
for i:= 0 to TreeView1.Items.Count - 1 do
begin
Obj:= TMyObject(TreeView1.Items.Item[i].Data);
if Assigned(Obj) then
Obj.Free;
end;