I am not sure how to assign data to a node in a VirtualStringTree. I'm need to assign a pointer to a record object to the Node's Data property in the tree control's InitNode event. However I'm getting a 'Pointer type required' compile-time error.
type
TDiagData = record
DiagID: Integer;
DiagName: String;
Selected: Byte;
end;
PDiagData = ^TDiagData;
var
FDiagDataList: TObjectList;
c: Integer; // used as an iterator for the list // incremented in vst1InitNode
procedure Btn1Click;
var
DiagData : PDiagData;
begin
try
FDiagDataList := TObjectList.Create; // TODO: Move this to form constructor
for c := 1 to 10 do
begin
New(DiagData);
DiagData.DiagID := c;
DiagData.DiagName := Format('Diag# %d', [c]);
FDiagDataList.Add(DiagData);
end;
c := 0;
vst1.NodeDataSize := SizeOf(TDiagData);
vst1.RootNodeCount := 10; // test
finally
// FDiagDataList.Free; //TODO: Move this to form destructor
end
end;
procedure vst1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
DiagData: PDiagData;
begin
DiagData = TDiagData(FDiagDataList.Items[c]); // FDiagDataList is a TObjectlist
Node.Data^ := DiagData; // <--- this is not working ..
// The error is: Pointer type required.
Inc(c);
end;
I need to assign the data to the node in the InitNode event, but not am sure how to assign it.
Do not read or write Node.Data directly. The data you need won't necessarily be exactly at the address of that field. (The tree control has a mechanism for allowing descendants to reserve additional data for themselves.) Instead, call Sender.GetNodeData.
var
NodeData: PDiagData;
begin
NodeData := Sender.GetNodeData(Node);
NodeData^ := TDiagData(FDiagDataList.Items[c]);
end;
Your code fails because Node.Data has type record; you cannot dereference it with ^. In the simple case, the value returned by GetNodeData will be equal to the address of that field (i.e., GetNodeData(Node) = #Node.Data). But don't assume all cases are simple. As I said, tree-control descendants can reserve data space of their own, so you're sharing that space with code that's outside your control, and it's up to the tree control to manage which data space is yours. Always call GetNodeData.
Furthermore, you're confused about your data types. You say FDiagDataList is a TObjectList, but you're clearly storing something in it that isn't a descendant of TObject. When you're not using objects, don't use TObjectList. If you're using a version of Delphi earlier than 2009, then use TList and store pointers to TDiagData:
NodeData^ := PDiagData(FDiagDataList[c])^;
If you're using Delphi 2009 or later, then use TList<TDiagData>, and then get rid of the type cast:
NodeData^ := FDiagDataList[c];
Either way, you'll probably find things easier to manage if every event handler starts out the same way, with a call to GetNodeData to fetch the type-safe pointer to the current node's data.
Related
is this piece of code safe from memory leaks?
s := TStringList.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object to live somewhere in memory
end;
function GetSomeSettings : TStringList;
var
rawString : string;
settings : TStringList;
begin
// Singleton pattern implementation
// Trying to find already existing settings in class variable
settings := TSettingsClass.fSettings;
// If there is no already defined settings then get them
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TSettingsClass.fSettings := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
end;
Result := settings;
end;
I'm wondering s := GetSomeSettings; potentially harmful and ignoring first object, keeps it in the memory?
Yes, the StringList created on line 1 is leaked.
Essentialy, you are doing:
s := TStringList.Create;
s := AnotherStringList;
AnotherStringList.Free;
As for the GetSomeSettings routine:
Normally it is not wise or encouraged to return newly created instances as function results, because you transfer the responsibility for ownership and destruction to the calling code. Unless you have a mechanism/framework in place that takes care of it, which seems to be the case with your TSettingsClass, but there is not enough evidence for that in this little piece of code.
Nevertheless, the combination of both pieces of code display another problem: After s.Free, TSettingsClass.fSettings is destroyed but not nil. Thus the second time GetSomeSettings is called, it returns a dangling pointer.
1) you should not ask when you can check in two minutes!
program {$AppType Console};
uses Classes, SysUtils;
type TCheckedSL = class(TStringList)
public
procedure BeforeDestruction; override;
procedure AfterConstruction; override;
end;
procedure TCheckedSL.BeforeDestruction;
begin
inherited;
WriteLn('List ',IntToHex(Self,8), ' going to be safely destroyed.');
end;
procedure TCheckedSL.AfterConstruction;
begin
WriteLn('List ',IntToHex(Self,8), ' was created - check whether it is has matched destruction.');
inherited;
end;
procedure DoTest; var s: TStrings;
function GetSomeSettings: TStrings;
begin Result := TCheckedSL.Create end;
begin
Writeln('Entered DoTest procedure');
s := TCheckedSL.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object
end;
Writeln('Leaving DoTest procedure');
end;
BEGIN
DoTest;
Writeln;
Writeln('Check output and press Enter when done');
ReadLn;
END.
2) Still that could be safe in few niche cases.
in FPC (http://FreePascal.org) S could be a "global property" of some unit, having a setter which would free old list.
in Delphi Classic S could be of some interface type, supported by the created object. Granted, standard TStringList lacks any interface, but some libraries ( for example http://jcl.sf.net ) do offer interface-based string lists, with richer API (iJclStringList type and related).
in Delphi/LLVM all objects were made reference-counted, like interfaces without GUID's. So that code would be safe there.
You can declare S as a record - a so-called Extended Record having re-defined class operator Implicit so that the typecast s{record} := TStringList.Create would free the previous instance before assigning a new one. That is dangerous though, as it is VERY fragile and easy to misuse, and destroy the list in some other place leaving a dangling pointer inside the S record.
Your object may be not that vanilla TStringList, but some subclass, overriding constructors or AfterConstruction to register itself in some list, that would be all-at-once in some place. Kind of Mark/Sweep heap management around large chunk of workload. VCL TComponent may be seen as following this pattern: form is owning its component and frees them when needed. And this is what you - in reduced form - are trying to do with TSettingsClass.fSettings containter (any reference is 1-sized container). However those frameworks do require a loopback: when the object is freed it should also remove itself from all the containers, referencing it.
.
procedure TCheckedSL.BeforeDestruction;
begin
if Self = TSettingsClass.fSettings then TSettingsClass.fSettings := nil;
inherited;
end;
class procedure TSettingsClass.SetFSettings(Value);
var fSet2: TObject;
begin
if fSettings <> nil then begin
fSet2 := fSettings;
f_fSettings := nil; // breaking the loop-chain
fSet2.Destroy;
end;
f_fSettings := Value;
end;
class destructor TSettingsClass.Destroy;
begin
fSettings := nil;
end;
However then - by the obvious need to keep design symmetric - the registration should also be done as a part of the class. Who is responsible for de-registration is usually the one responsible for registration as well, unless there are reasons to skew the design.
procedure TCheckedSL.AfterConstruction;
begin
inherited;
TSettingsClass.fSettings := Self;
end;
...
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TCheckedSL.Create.Text := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
Assert( Assigned(settings), 'wrong class used for DB settings' );
end;
Result := settings;
I need move the data stored in a array of bytes to a set of records located in a TList, but i'm getting this error
E2197 Constant object cannot be passed as var parameter
This code reproduce the issue.
uses
System.Generics.Collections,
System.SysUtils;
type
TData = record
Age : Byte;
Id : Integer;
end;
//this code is only to show the issue, for simplicity i'm filling only the first
//element of the TList but the real code needs fill N elements from a very big array.
var
List : TList<TData>;
P : array [0..1023] of byte;
begin
try
List:=TList<TData>.Create;
try
List.Count:=1;
//here i want to move the content of the P variable to the element 0
Move(P[0],List[0], SizeOf(TData));
finally
List.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
How i can copy the contents of a buffer to a TList Element
In XE2, the internal storage for TList<T> is opaque and hidden. You cannot gain access to it by normal means. All access to elements of the list are copied – references to the underlying storage are not available. So you cannot blit to it using Move. If you want a structure that you can blit to, you should consider a dynamic array, TArray<T>.
You can always use the trick of implementing a class helper for TList<TData> that would expose the private variable FItems. That's pretty hacky but will do what you ask.
type
__TListTData = TList<TData>;
//defeat E2086 Type 'TList<T>' is not yet completely defined
type
TListTDataHelper = class helper for TList<TData>
procedure Blit(const Source; Count: Integer);
end;
procedure TListTDataHelper.Blit(const Source; Count: Integer);
begin
System.Move(Source, Pointer(FItems)^, Count*SizeOf(Self[0]));
end;
I guess you might want to put some parameter checking in TListTDataHelper.Blit, but I'll leave that to you.
If you were using XE3, you could access the private storage of TList<T> by using the List property.
Move(P, Pointer(List.List)^, N*SizeOf(List[0]));
If you don't need to blit and can use a for loop then do it like this:
type
PData = ^TData;
var
i: Integer;
Ptr: PData;
....
List.Count := N;
Ptr := PData(#P);
for i := 0 to List.Count-1 do
begin
List[i] := Ptr^;
inc(Ptr);
end;
But I interpret your question that you wish to avoid this option.
Instead of using Move(), try using the TList<T>.Items[] property setter instead and let the compiler and RTL handle the copying for you:
type
PData = ^TData;
...
List[0] := PData(#P[0])^;
I have a cxTreeView on a form displaying descriptions of some files. I would like to be able to have the option of clicking one of the descriptions and have the filename returned.
In order to do this I need to store some extra data in the treeview and that is my problem.
How do I do this:
Store both filename and description, display just the description but get the filename by doubleclicking?
I think you can use a TcxTreeList for this task (if possible), if there is no urgent need to use a TcxTreeView. In a TcxTreeList you can add a new column and store the filename in it. Then make this column invisible.
If you must rely on a TcxTreeView, there is no option to directly store data, like strings, in the TTreeNodes. You can store a pointer to any object into the property "Data" of the TTreeNode.
In both answers here is mentioned that TcxTreeView uses standard TTreeNode where, as Warren pointed in his answer as first, you can use the TTreeNode.Data property to store your data. I'll just complete these thoughts with an example.
Update:
The previous version of this post would work only for constant strings for whose the space is being allocated automatically. If you need to pass a variable into the TTreeNode.Data you have to allocate and release the memory by your own. Here is the example with using simple helper functions.
The AddFileNode helper function adds the node to the Items into the ParentNode with the name of the FileDesc and allocates the space and copy the passed FileName for the TTreeNode.Data by using the StrNew function.
When you need to modify the data, you should release (or better, but little bit complicated would be to reallocate) the allocated memory and allocate the space and copy the new value. For this you can use the ChangeFileName which disposes the string memory allocated before and allocates the space and copy the passed FileName value.
As I mentioned before you need to take care of the memory disposal by your own and for this there is the OnDeletion event the best place. So write the handler for this event where you'll release the memory allocated when adding the items.
function AddFileNode(Items: TTreeNodes; ParentNode: TTreeNode;
const FileName, FileDesc: string): TTreeNode;
begin
Result := Items.AddChildObject(ParentNode, FileDesc, StrNew(PChar(FileName)));
end;
function ChangeFileName(TreeNode: TTreeNode; const FileName: string): Boolean;
begin
Result := False;
if Assigned(TreeNode.Data) then
begin
Result := True;
StrDispose(PChar(TreeNode.Data));
TreeNode.Data := StrNew(PChar(FileName));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
S := 'C:\FileName 1.xxx';
AddFileNode(cxTreeView1.Items, nil, S, 'File 1');
S := 'C:\FileName 2.xxx';
AddFileNode(cxTreeView1.Items, nil, S, 'File 2');
end;
procedure TForm1.cxTreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
if Assigned(Node.Data) then
StrDispose(PChar(Node.Data));
end;
procedure TForm1.cxTreeView1DblClick(Sender: TObject);
var
CurrentPos: TPoint;
CurrentNode: TTreeNode;
begin
CurrentPos := cxTreeView1.ScreenToClient(Mouse.CursorPos);
if (htOnItem in cxTreeView1.GetHitTestInfoAt(CurrentPos.X, CurrentPos.Y)) then
begin
CurrentNode := cxTreeView1.GetNodeAt(CurrentPos.X, CurrentPos.Y);
if Assigned(CurrentNode) and Assigned(CurrentNode.Data) then
ShowMessage(PChar(CurrentNode.Data));
end;
end;
If the nodes are regular TTreeNode, you can use the Data:Pointer value in the Node object.
If the nodes in your tree are of type TcxTreeListNode, they contain the ability to store any data values you want. WHen I look at the sources, I see these properties in the node-level:
property ValueCount: Integer read GetValueCount;
property Values[Index: Integer]: Variant read GetValue write SetValue;
I have a design and run-time component that contains a large number of event handlers. I'll call it TNewComp for now. I create an instance of TNewComp on a TForm and fill in the event stubs with specific code via the property editor at design time, and realize I would like to be able to create new instances of TNewcomp that use the current set of event handler code.
To do this now, I call TNewComp's constructor and then "manually" assign each of the new instance's event handlers the corresponding event stub code resident on the form that contains the TNewComp instance created at design time. So if I have an instance of TNewComp assigned to a variable named FNewComp on a form called TNewForm, for each event handler I would do:
FNewComp.onSomething = TNewform.onSomething
(... repeat for each event handler belonging to TNewComp ...)
This works fine, but it is cumbersome and worse, if I add a new event handler to TNewComp, I have to remember to update my "newTComp()" function to make the event handler assignment. Rinse and repeat this process for every unique component type that I create new instances of dynamically.
Is there way to automate this process, perhaps using property inspection or some other Delphi 6 introspection technique?
-- roschler
I used the following code. Be careful with the Dest owner when creating, the safest way is to pass Nil and free the component by yourself later.
implementation uses typinfo;
procedure CopyComponent(Source, Dest: TComponent);
var
Stream: TMemoryStream;
TypeData : PTypeData;
PropList: PPropList;
i, APropCount: integer;
begin
Stream:=TMemoryStream.Create;
try
Stream.WriteComponent(Source);
Stream.Position:=0;
Stream.ReadComponent(Dest);
finally
Stream.Free;
end;
TypeData := GetTypeData(Source.ClassInfo);
if (TypeData <> nil) then
begin
GetMem(PropList, SizeOf(PPropInfo)*TypeData^.PropCount);
try
APropCount:=GetPropList(Source.ClassInfo, [tkMethod], PropList);
for i:=0 to APropCount-1 do
SetMethodProp(Dest, PropList[i], GetMethodProp(Source, PropList[i]))
finally
FreeMem(PropList);
end;
end;
end;
One option would be to save "the properly set up component" into stream and then load that strem into new, dynamically created component as if it is done by Delphi IDE/runtime.
Another option is to use RTTI, the TypInfo unit. There you have function GetPropList witch will enable you to query for available events (TypeKind tkMethod) and then you can use GetMethodProp and SetMethodProp to copy eventhandlers from one component to other.
I tweaked Maksee's solution to the following:
function CopyComponent(Source: TComponent; Owner: TComponent = nil): TComponent;
var
Stream: TMemoryStream;
TypeData : PTypeData;
PropList: PPropList;
i, APropCount: integer;
begin
if not Assigned(Source) then
raise Exception.Create('(CopyComponent) The Source component is not assigned.');
Result := TComponent.Create(Owner);
Stream := TMemoryStream.Create;
try
Stream.WriteComponent(Source);
Stream.Position := 0;
Stream.ReadComponent(Result);
finally
Stream.Free;
end; // try()
// Get the type data for the Source component.
TypeData := GetTypeData(Source.ClassInfo);
if (TypeData <> nil) then
begin
// Get the property information for the source component.
GetMem(PropList, SizeOf(PPropInfo) * TypeData^.PropCount);
try
// Get the properties count.
APropCount := GetPropList(Source.ClassInfo, [tkMethod], PropList);
// Assign the source property methods to the destination.
for i := 0 to APropCount - 1 do
SetMethodProp(Result, PropList[i], GetMethodProp(Source, PropList[i]))
finally
// Free the property information object.
FreeMem(PropList);
end; // try()
end; // if (TypeData <> nil) then
end;
So that a new component is returned by the function rather than passing in an existing component reference (the Dest parameter in Maksee's version). If anyone can see a flaw or problem that will result from this variant please comment.
In my app I have different forms that use the same datasource (so the queries are the same too), defined in a common datamodule. Question is, is there a way to know how many times did I open a specific query? By being able to do this, I could avoid close that query without closing it "every where else".
Edit: It's important to mention that I'm using Delphi3 and it is not a single query but several.
The idea is to use the DataLinks property of the TDataSource.
But, as it is protected, you have to gain access to it. One common trick is to create a fake descendant just for the purpose of casting:
type
TDataSourceHack = class(TDataSource);
Then you use it like:
IsUsed := TDataSourceHack(DataSource1).DataLinks.Count > 0;
You can get creative using a addref/release like approach. Just create a few functions and an integer variable in your shared datamodule to do the magic, and be sure to call them..partial code follows:
TDMShared = class(tDataModule)
private
fQueryCount : integer; // set to 0 in constructor
public
function GetQuery : tDataset;
procedure CloseQuery;
end;
function TDMShared.GetQuery : tDataset;
begin
inc(fQueryCount);
if fQueryCount = 1 then
SharedDatsetQry.open;
Result := shareddatasetqry; // your shared dataset here
end;
procedure TDMShared.CloseQuery;
begin
dec(fQueryCount);
if fQueryCount <= 0 then
shareddatasetqry.close; // close only when no refs left.
end;
EDIT: To do this with multiple queries, you need a container to hold the query references, and a way to manipulate them. a tList works well for this. You will need to make appropriate changes for your TDataset descendant, as well as create a FreeAndNil function if you are using an older version of Delphi. The concept I used for this was to maintain a list of all queries you request and manipulate them by the handle which is in effect the index of the query in the list. The method FreeUnusedQueries is there to free any objects which no longer have a reference...this can also be done as part of the close query method, but I separated it to handle the cases where a specific query would need to be reopened by another module.
Procedure TDMShared.DataModuleCreate(Sender:tObject);
begin
dsList := tList.create;
end;
Function TDMShared.CreateQuery(aSql:String):integer;
var
ds : tAdoDataset;
begin
// create your dataset here, for this example using TADODataset
ds := tAdoDataset.create(nil); // self managed
ds.connection := database;
ds.commandtext := aSql;
ds.tag := 0;
Result := dsList.add(ds);
end;
function TDMShared.GetQuery( handle : integer ) : tDataset;
begin
result := nil;
if handle > dsList.count-1 then exit;
if dsList.Items[ handle ] = nil then exit; // handle already closed
result := tAdoDataset( dsList.items[ handle ]);
Inc(Result.tag);
if Result.Tag = 1 then
Result.Open;
end;
procedure TDMShared.CloseQuery( handle : integer );
var
ds : tAdoDataset;
begin
if handle > dsLIst.count-1 then exit;
ds := tAdoDataset( dsList.items[ handle ]);
dec(ds.Tag);
if ds.Tag <= 0 then
ds.close;
end;
procedure TDMShared.FreeUnusedQueries;
var
ds : tAdoDataset;
ix : integer;
begin
for ix := 0 to dsList.Count - 1 do
begin
ds := tAdoDataset(dsLIst.Items[ ix ]);
if ds.tag <= 0 then
FreeAndNil(dsList.Items[ix]);
end;
end;
procedure TDMShared.DataModuleDestroy(Sender: TObject);
var
ix : integer;
begin
for ix := 0 to dsList.count-1 do
begin
if dsLIst.Items[ix] <> nil then
FreeAndNil(dsLIst.Items[ix]);
end;
dsList.free;
end;
Ok, a completely different solution...one that should work for Delphi 3.
Create a new "Descendant Object" from your existing dataset into a new unit, and add some behavior in the new object. Unfortunately I do not have Delphi 3 available for testing, but it should work if you can find the proper access points. For example:
TMySharedDataset = class(tOriginalDataset)
private
fOpenCount : integer;
protected
procedure Internal_Open; override;
procedure Internal_Close; override;
end;
TMySharedDataset.Internal_Open;
begin
inherited Internal_Open;
inc(fOpenCount);
end;
TMySharedDataset.Internal_Close;
begin
dec(fOpenCount);
if fOpenCount <= 0 then
Inherited Internal_Close;
end;
Then just include the unit in your data module, and change the reference to your shared dataset (you will also have to register this one and add it to the palette if your using components). Once this is done, you won't have to make changes to the other units as the dataset is still a descendant of your original one. What makes this all work is the creation of YOUR overridden object.
You could have a generic TDataSet on the shared datamodule and set it on the OnDataChange, using the DataSet property of the Field parameter
dstDataSet := Field.DataSet;
This way, when you want to close the dataset, close the dataset on the datamodule, which is a pointer to the correct DataSet on some form you don't even have to know