How should I dereference a local variable to get the address of a record element in a TList? - pointers

I am converting a Delphi app from using a TTreeView to using a TVirtualStringTree; The node data is held in TItemData records in a TList.
type
TItemData = record
idName: string;
end;
PItemData = ^TItemData
TMyForm = class(TForm)
...
private
itemData: TList<TItemData>;
..
end;
I wanted to get the displayed tree up and running in the most straightforward way possible, and then gradually convert the app little by little as I got to understand how to use the VirtualStringTree. So, I have a buildTreeFromItemData() method, which iterates through the TList elements and creates child nodes in the VirtualStringTree. I [tried to] pass a pointer to each TItemData record in each call to VST.addChild() which would then be dereferenced in vstGetText(), something like this:
procedure buildTreeFromItemData;
var
i: integer;
idA: TItemData;
begin
for i := 0 to itemData.count - 1 do begin
idA := itemData[i];
vst.addChild(NIL, #idA);
end;
end;
Dereference the pointer:
procedure TMyForm.vstGetData(...);
var
idB: TItemData;
begin
idB := node.getData^;
CellText := idB.idName;
end;
It quickly became apparent that no matter how many different ways I tried to code this, e.g. #itemData[i], the only times my code compiled every vst node was actually getting the address of the idA local variable, and every tree node was pointing to the most recent TItemData record pointed to by idA. I was then getting access violations in vstGetText() once buildTreeFromItemData() had completed and the local idA variable went out of scope, i.e. every node's data pointer in vst was now invalid.
Most of my attempts to somehow deference idA and get at the address location of the TItemData stored in idA generated an "invalid typecast" from the Delphi syntax checker, let alone the compiler.
At one point I tried something like this:
ptr1^ := #idA;
I have no idea what that actually means to the Delphi compiler. I know what I wanted it to mean: I wanted it to mean "set ptr1 to the [dereferened] address stored at the address of the idA local variable". To my surprise, it compiled but went bang as soon as the debugger hit that statement. (What does the compiler think "ptr1^ := " means?)
Eventually I hit upon the idea of typecasting idA to a TObject; at least then, my thinking went, the compiler would know we were at least in the realms of dereferencing and might actually let me, eventually, get to the pointer I really needed to pass to vst.addChild().
After much experimentation, and many more "invalid typecast"s, unbelievably [at least to me] the following code works!.....
procedure buildTreeFromItemData;
var
i: integer;
idA: TItemData;
myObj: TObject;
ptr1: pointer;
ptr2: PItemData;
begin
for i := 0 to itemData.count - 1 do begin
idA := itemData[i];
myObj := TObject(#idA);
ptr1 := pointer(myObj)
ptr2 := PItemData(ptr1^);
vst.addChild(NIL, ptr2);
end;
end;
ptr2 is now so far removed, syntactically and semantically, from idA, that the compiler finally allows the dereference in PItemData(ptr1^), although it only allowed it after I added the PItemData(...) typecast.
I don't even have to dereference this pointer in vstGetText!...
procedure TMyForm.vstGetText(...);
var
idB: PItemData;
begin
idB := PItemData(node.getData);
CellText := idB.idName;
end;
The tree displays perfectly and the access violations are gone. (NB. The actual code in buildTreeFromItemData() is a lot more involved and creates child nodes of child nodes to create a complex tree structure several levels deep.)
Although I eventually found a solution at gone 1am this morning after a lot of trial and error, I find it difficult to believe that my jiggerypokery with the local variable is really necessary for something so simple. So my question is this: what is the correct Delphi syntax for getting the address of my TItemData record stored in a plain "idA: TItemData;" local variable?
(I think this is my first ever question to stackoverflow; I hope I have formulated it well enough. I've kept the code to the absolute bare bones necessary to illustrate the issue and I wasn't able to completely reproduce the exact experimentation code I went through. The solution in the final two code blocks, though, is my working code. If I can improve how I've formulated the question and the explanation to meet stackoverflow's stringent standards, please let me know.)

what is the correct Delphi syntax for getting the address of my TItemData record stored in a plain "idA: TItemData;" local variable?
Well... That one is simple. You do it like this : #idA.
The issue here is that it is NOT what you want to do. You want to have the address of the TItemData in your list (idA is merely a copy of the record in itemData).
To get the address of a value inside of a TList<T>, you can't use property Items[Index: Integer]: T of TList<T> as it will only return you a copy of the value. You need to use property List: arrayofT which will give you direct access the underlying array in which the values are stored, and then you can get the address with : #itemData.List[I].
That being said, it is not something I would recommend. There is no guarantees how long that pointer will remain valid. There is a lot of operations on the list that might render that address invalid, or make it point to the wrong TItemData. If itemData is immutable by the time you acquire the pointer, it's should be ok. Otherwise, it would be way better to allocate new TItemData like described by IVO GELOV in his answer.
Answer to comment :
is there no legit Delphi syntax to achieve what I managed to do?
You did not manage to do what you think you did.
idA := itemData[i]; //Copy the value from the list
myObj := TObject(#idA); //Take the address of iDA and pretend it's a TObject
ptr1 := pointer(myObj) //Now, pretend my TObject is a Pointer
ptr2 := PItemData(ptr1^); //Now, pretend ptr1 is pointing to a PItemData.
//I didn't test it, but I'm pretty sure you could have just written `ptr2 := PItemData((#iDA)^)`
vst.addChild(NIL, ptr2);
So what does this code do? The "main event" here is ptr2 := PItemData(ptr1^). It takes the address of idA, take the first PointerSize(For simplicity, I'll assume 32 bits going forward) byte at that address and pretend it's a PItemData. What are the first 32 bit of TItemData? A string, more precisely idName. Maybe it will help you understand to consider that #idA = #idA.IdName.
So, in other words, vst.addChild(NIL, ptr2); is the same as vst.addChild(NIL, PChar(idA.idName)); or vst.addChild(NIL, #idA.idName[1]); (except for empty string... but I digress). So, what you add in the vst is not the address of the record in itemData, it's the address of the first character of the string idA.idName.
But, your confusion is probably coming from believing records are reference types. They are not, they are value types.

The idea of TVirtualTree is to store your data inside the nodes. TVirtualTree will reserve memory for your data and that's why you need to tell the tree how big is your data.
So, when your form is created (inside OnCreate handler) you should set the NodeDataSize property of your VirtualTree:
procedure TmyForm.TntFormCreate(Sender: TObject);
begin
inherited;
myVirtualTree.NodeDataSize:=SizeOf(TItemData);
end;
You should also handle the OnFreeNode event from your VirtualTree:
procedure TmyForm.myVirtualTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data:PItemData;
begin
Data:=Sender.GetNodeData(Node);
if Assigned(Data) then Finalize(Data^);
end;
When you want to create a new node in the tree:
procedure TmyForm.CreateNewNode(data:TItemData);
var
node: PItemData;
P: PVirtualNode;
begin
with myVirtualTree do
begin
P:=AddChild(Nil);
node:=GetNodeData(P);
node^:=data;
// ReinitNode is very important - to update InternalNode precomputed
// text width. Otherwise node can not be properly selected if
// FullRowSelect is FALSE
ReinitNode(P,False);
end;
end;
You will also need to handle other events from TVirtualTree like OnGetText, onPaintText, onCompareNodes, onIncrementalSearch, onDblClick, onGetHint, etc.

Related

Comparing datetimes in delphi

I am developing a quizing game in Delphi and I would like to have a timer so that players don´t have unlimited time to answer the questions. I am using the function "Time" to get the current time but I don´t know how to convert it to something like an integer so that when let´s say 10 seconds have passed the player loses it´s chance. It would look like something like this:
Var
CurrentTime,Aux:TDateTime;
Begin
CurrentTime:=Time; //Current Time is assigned to a global variable.
Aux:=CurrentTime;
While (Aux-10000<=CurrentTime) do
Begin
if (Answer:=True) then //If the answer is already given by the player we break the while loop
Break;
Aux:=Time; //We refresh the auxilary variable
if (Aux-10000>=CurrentTime) then //We check if 10 seconds have passed
Begin
showmessage('You have taken too much time, your turn is lost');
exit; //We leave the script
end;
end;
end;
The problem is I can´t do arithmetic operations in DateTimes, as far as I know, So I need a different method for comparing the 2 different time instances. Any help would be appreciated, thanks!
TDate, TTime, and TDateTime are implemented using floating-point numbers, so you can perform arithmetic operations on them.
But you really shouldn't, in this case. The DateUtils unit has many functions for working with date/time values, eg:
uses
..., DateUtils;
var
StartTime, Aux: TDateTime;
begin
StartTime := Time();
Aux := StartTime;
...
while (not Answer) and (MillisecondsBetween(Aux, StartTime) < 10000) do
begin
Sleep(0);
Aux := Time();
end;
if (not Answer) then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
...
end;
Note that this is not really a good use for TDateTime. Your calculations are relying on the system clock in local time being accurate and unchanging, but it can be changed dynamically while your code is running (user updates, network updates, daylight saving time change, etc), throwing off the results.
Consider using TStopWatch instead. It is intended for exactly this kind of use-case (determining elapsed time between actions), eg:
uses
..., System.Diagnostics;
var
SW: TStopWatch;
begin
SW := TStopWatch.StartNew;
...
while (not Answer) and (SW.ElapsedMilliseconds < 10000) do
Sleep(0);
if (not Answer) then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
...
end;
Or, you could use TEvent instead, and have the answer signal the event when ready, eg:
uses
..., SyncObjs;
var
AnsweredEvent: TEvent;
...
// when the answer is submitted:
AnsweredEvent.SetEvent;
...
begin
AnsweredEvent.ResetEvent;
...
if AnsweredEvent.WaitFor(10000) <> wrSignaled then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
end;
initialization
AnsweredEvent := TEvent.Create;
finalization
AnsweredEvent.Free;
I have written a few applications like this, using a TTimer. The timer's interval is set to 1000, which is equivalent to 1 second (you can use a different value); every time the timer's OnTimer event executes, a global variable is incremented which is then checked against the time limit (10 seconds?); if the variable equals this limit then first the timer is stopped, then the code performs whatever is necessary to transfer to the next person, or next question.
There should be similar code that executes when the person enters an answer as this code too needs to first save the answer then transfers to the next person. This portion should also stop the timer.
The 'show next question' part should restart the timer and reset the global variable only after the next question has been displayed, as it might take some time for it to be fetched.

How get AReadLinesCount IdTCPClient

There is a certain remote server. I want to get an answer from him
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
IdTCPClient1.Host := '163.158.182.243';
IdTCPClient1.Port := 28900;
IdTCPClient1.Connect;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.IOHandler.Write('001');
IdTCPClient1.IOHandler.ReadStrings(Memo1.Lines, 25, IndyTextEncoding(IdTextEncodingType.encOSDefault));
end;
The procedure requires a parameter to specify AReadLinesCount, otherwise the program stops responding
procedure TIdIOHandler.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
How to AReadLinesCount from the responses received
The server needs to tell your client when to stop reading. There are two ways it can do that:
It can send the number of lines before sending the lines themselves. You would read the number first, and then read the specified number of lines that follow.
It can send a unique terminating delimiter after sending the lines. You would read lines in a loop until you reach the terminator.
You have not provided any details about the protocol you are trying to implement, so noone can tell you exactly what to write in your code to make this work.

Opening and closing database connections in multiuser environment

This is a multiuser application (multithreaded) where various departments will access their own database.The database is SQLite and I am using FireDac.For each department I have assigned a separate ADConnection so I dont get any unexpected locks.
Which connection will be activated (active) depends solely on the number produced by the ADQuery3. This is done on MainForm Show because it needs to be this way (which gets shown after successfull login). I would like to be able to close every connection on FormClose but I run into some bad issues when multiusers use the same database and log in and out.So I would like to ask if this is the right programming logic I am doing or this could be done in a better way?
Also I have never used this many begin end else and I am wondering how to proceed with this?
I mean when I need to check the if the number of another department came up, like
if DataModule1.ADQuery3.FieldByName('DEPARTMENT').AsString = '12' where does the next ELSE come up?
procedure TMainForm.FormShow(Sender: TObject);
begin
if DataModule1.ADQuery3.FieldByName('DEPARTMENT').AsString = '13'
then begin
try
if DataModule1.1_CONNECTION.Connected = true then
DataModule1.1_CONNECTION.Connected := False
else
DataModule1.1_CONNECTION.DriverName:= 'SQLite';
DataModule1.1_CONNECTION.Params.Values['Database']:= ExtractFilePath(Application.ExeName)+ 'mydatabase.db';
DataModule1.1_CONNECTION.Connected := true;
DataModule1.ADTable1.TableName :='DEPT_13';
DataModule1.DEPT_13.Active:=True;
cxGrid1.ActiveLevel.GridView := DEPT_13;
except
on E: Exception do begin
ShowMessage('There was an error... : ' + E.Message);
end;
end;
end;

What is correct Delphi syntax to set a SQL query parameter value from a stream?

I use a web site that requires a logon and at one point shows a jpg using the http
<img src="https://www.theurl.com/pictures/Photo.ashx?theid=221">
I want to use Delphi to download this image (and others by using a different parameter) and store it in a SQLite database.
I am able to take a jpg file from my HDD and store it in the database with..
procedure TForm1.Button1Click(Sender: TObject); //this works
begin
DISQLite3Database1.DatabaseName := 'C:\testphoto.db';
DISQLite3Database1.Open;
try
Query1.Close;
Query1.selectSQL := ('insert into StudentPhotos(id,photo)
values(''sally'', :photo)');
Query1.Params.ParamByName('photo').LoadFromFile
('C:\Users\Admin\Documents\testpic2.jpg',ftGraphic);
Query1.Open ;
finally
DISQLite3Database1.close;
end;
end;
I am also able to download the image from the website into a file using the following (after running code that handles the logon)
procedure TForm1.Button2Click(Sender: TObject);
var
Strm: TMemoryStream;
HTTP: TIdHTTP;
LHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
try
http:= TIdHTTP.create; //make an http component
LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
Strm := TMemoryStream.Create;
HTTP.IOHandler:=LHandler;
HTTP.HandleRedirects := true;
HTTP.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'; try
Http.Get('https://www.TheUrl.com/picures/Photo.ashx?theid=221' , Strm);
Strm.Position := 0;
Strm.SaveToFile('C:\Users\Admin\Documents\testpic2.jpg');
except
on e:Exception do
begin
ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
showmessage('could not download file');
end;
end;
finally
http.Free;
LHandler.Free ;
Strm.free;
end;
end;
However I'd prefer not to save each file on the clients hard drive and then read it back in to save it into the database as that will be quite slow.
Question
What is the correct syntax to combine both of the above procedures so that I can download into a stream and then pass the stream directly into the query parameter ready to save it in the database?
Note I am using DISQLIte3 but the query methods/properties are similar to other components.
Most classes that have a LoadFromFile also have a LoadFromStream. Have you tried that?
ie.
Query1.Params.ParamByName('photo').LoadFromStream(Strm,ftGraphic);
# Joe Meyer - Yes I saw that link, it doesn't have anything to do with databases. Like most things I have seen over the last two days it only deals with blobs going to and from images
#bummi & HeartWare
I tried loads of different combinations of ... ParamByName('photo').LoadFromStream()... using Tfilestream and TmemoryStream but kept getting incompatible type errors, maybe because I didn't know what TBlobType to use when dealing with jpgs as opposed to bitmaps.
I copied exactly what you proposed into my first procedure to get
begin
DISQLite3Database1.DatabaseName := 'C:\Users\Admin\Documents\RAD Studio\Projects\sqlite with photos\testphoto.db';
DISQLite3Database1.Open;
try
strm := TmemoryStream.Create;
strm.LoadFromFile('C:\Users\Admin\Documents\RAD Studio\Projects\sqlite with photos\testpic2.jpg');
Query1.Close;
Query1.selectSQL := ('insert into StudentPhotos(id,photo) values(''sally'', :photo)');
Query1.Params.ParamByName('photo').LoadFromStream(Strm,ftGraphic);
Query1.Open ;
finally
strm.Free ;
DISQLite3Database1.close;
end;
end;
... and it worked first time!
I think sometimes when developing one can't see the wood for the trees.
I should be able to work out the rest now, Thanks to you both

Ada entry and when statement usage

I am a newbie in Ada programming language and I am working on concurrent programming, but I am having a problem with one implementation. This might be very dummy question. The code is:
type status is array(1..6) of boolean; --boolean values for each track
track_available :status:=(others=>true); --true if track is available
protected track_handler is
entry track_req(n:in track_part_type); --n is track number
entry track_rel(n:in track_part_type); --n is track number
end track_handler;
protected body track_handler is
--implement entries
entry track_req(n: in track_part_type) when track_available(n) is --here where the error occurs
begin
req(n);
end track_req;
entry track_rel(n: in track_part_type) when track_available(n) is
begin
rel(n);
end track_rel;
end track_handler;
procedure req(nr : track_part_type) is
begin
--null;
track_available(nr):=false;
end req;
procedure rel(nr : track_part_type) is
begin
--null;
track_available(nr):=true;
end rel;
Here I get a compilation error for "when track_available(n)" statement saying that "n is undefined". I think variable n is out of scope, but I also need to check if the n'th index of the array is true or false. How can I overcome this problem?
Thank you.
You can't actually use an entry's parameters in its own guard. You got that much, I gather.
The way guards work, all of them are evaluated before the wait starts, and only the ones that are active at that time will be available. They don't get periodicly re-evaluated or dynamicaly read or anything.
This means it will be tough to get the logic for your guards right, unless you write your code so that only other entries in your protected object modify the guards. If you want to use some data from outside of your protected object to control its behavior, you will probably need to use some mechanisim other than guards to do it. Like check just inside the entry and exit immediately or something.
There is one possibility for what you are trying to do though: Entry families. You should be able to use an entry family index in a guard.
The spec would change to:
entry track_req(track_part_type);
entry track_rel(track_part_type);
And the body would change to
entry track_req(for n in track_part_type) when track_available(n) is
begin
req(n);
end track_req;
entry track_rel(for n in track_part_type) when track_available(n) is
begin
rel(n);
end track_rel;
end track_handler;
In the code below you are trying to use track_available(n), before it has been fully defined by (n: in track_part_type).
entry track_req(n: in track_part_type) when track_available(n) is
See also http://en.wikibooks.org/wiki/Ada_Programming/Tasking#Protected_types
NWS

Resources