### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: [SOLVED] VST summation time bugs  (Read 1481 times)

#### Pe3s

• Sr. Member
• Posts: 380
##### [SOLVED] VST summation time bugs
« on: February 01, 2023, 10:13:39 pm »
Hello how can I fix the code so that it counts the hours correctly from the Virtual String Tree column. E.g. 21x8=168 and the code gives 144

Code: Pascal  [Select][+][-]
1. procedure TForm1.SumHour;
2. var
3.   Data: PData;
4.   Node: PVirtualNode;
5.   SUM: TDateTime = 0;
6.   Time: TDateTime;
7. begin
8.   Node := VST.GetFirst();
9.   while Node <> nil do
10.   begin
11.     Data := VST.GetNodeData(Node);
12.     if TryStrToTime(Data^.iGodzin, Time) then
13.     SUM += Time;
14.     Node := VST.GetNext(Node);
15.   end;
16.   Panel2.Caption := 'Hour in month: ' + FormatDateTime('[hh]:nn', SUM, [fdoInterval]) +' h';
17. end;
18.
« Last Edit: February 06, 2023, 08:16:08 pm by Pe3s »

#### dseligo

• Hero Member
• Posts: 957
##### Re: VST summation time bugs
« Reply #1 on: February 04, 2023, 12:11:02 pm »
Maybe there is something wrong with your data?
Try by adding 'else' to 'if TryStrToTime(Data^.iGodzin, Time) then'. Maybe you'll catch something.

#### Pe3s

• Sr. Member
• Posts: 380
##### Re: VST summation time bugs
« Reply #2 on: February 04, 2023, 04:30:22 pm »
The data is correct if else returns nothing. Any ideas ?

#### bytebites

• Hero Member
• Posts: 546
##### Re: VST summation time bugs
« Reply #3 on: February 04, 2023, 05:40:19 pm »
AI chrystall ball is still under construction.
168-144=24 =1 day.

#### wp

• Hero Member
• Posts: 10669
##### Re: VST summation time bugs
« Reply #4 on: February 04, 2023, 06:31:36 pm »
Wrote a small test application to verify that your code is correct. The issue must be somewhere else in your code.

#### dseligo

• Hero Member
• Posts: 957
##### Re: VST summation time bugs
« Reply #5 on: February 04, 2023, 07:41:54 pm »
The data is correct if else returns nothing. Any ideas ?

Idea is: give test data and compileable code.

#### WooBean

• Full Member
• Posts: 179
##### Re: VST summation time bugs
« Reply #6 on: February 04, 2023, 07:57:19 pm »
Pe3s
I think that your usage of TryStrToTime(Data^.iGodzin, Time) leads to the error.
For returning TRUE for TryStrToTime valid parameter is from '00:00:00' to '23:59:59' (or '23:59:59.999' if your default formattings decimal separator is a dot) but not '24'!

« Last Edit: February 04, 2023, 08:02:05 pm by WooBean »
Platforms: Win7/64, Linux Mint Ulyssa/64

#### Pe3s

• Sr. Member
• Posts: 380
##### Re: VST summation time bugs
« Reply #7 on: February 04, 2023, 09:17:28 pm »
@wp, I downloaded your test application and noticed the same error if the number of rows is 21 then it counts 144 and not 168.
counts wrong on rows 21, 24, 27

What could this be due to and how can it be corrected?
« Last Edit: February 04, 2023, 09:33:08 pm by Pe3s »

#### wp

• Hero Member
• Posts: 10669
##### Re: VST summation time bugs
« Reply #8 on: February 04, 2023, 11:21:13 pm »
Ah...

This is not a problem of VirtualTreeView, but of FormatDateTime. The reason is that 8 hours = 8/24 day = 1/3 day. This is number cannot be represented exactly as a binary value (not even as a decimal value), and adding it up for 21 days the sum is not exactly 21 x 1/3 = 7 days, but when you do a WriteLn(sum) you will see the value 6.9999999999999973E+000. The problem is that FormatDateTime in the fdoInterval mode calculates the number of full days as trunc(abs(ADateTime) * 24), i.e. the 7 days of this example turn into 6 days...

The first idea for a solution is to replace the trunc by round: It turns the 6.99999999999 into 7 - perfect. But it calls for trouble: Suppose a TTime value of 1.75, i.e. 1 full day (24 hours) + 3/4 of a full day (18 hours), in total 42 hours. But the new "round" now makes 2 full day out of the 1.75 (48 hours), plus the 18 hours we get 66...

So I guess, the trunc should remain, but only if the total value is within some tolerance near to an integer round should be used.

Requires some thoughts...

#### dseligo

• Hero Member
• Posts: 957
##### Re: VST summation time bugs
« Reply #9 on: February 05, 2023, 03:54:30 am »
This is not a problem of VirtualTreeView, but of FormatDateTime. The reason is that 8 hours = 8/24 day = 1/3 day. This is number cannot be represented exactly as a binary value (not even as a decimal value), and adding it up for 21 days the sum is not exactly 21 x 1/3 = 7 days, but when you do a WriteLn(sum) you will see the value 6.9999999999999973E+000. The problem is that FormatDateTime in the fdoInterval mode calculates the number of full days as trunc(abs(ADateTime) * 24), i.e. the 7 days of this example turn into 6 days...

The first idea for a solution is to replace the trunc by round: It turns the 6.99999999999 into 7 - perfect. But it calls for trouble: Suppose a TTime value of 1.75, i.e. 1 full day (24 hours) + 3/4 of a full day (18 hours), in total 42 hours. But the new "round" now makes 2 full day out of the 1.75 (48 hours), plus the 18 hours we get 66...

So I guess, the trunc should remain, but only if the total value is within some tolerance near to an integer round should be used.

Requires some thoughts...

I would first multiply it with 24 and then round it.

#### Pe3s

• Sr. Member
• Posts: 380
##### Re: VST summation time bugs
« Reply #10 on: February 05, 2023, 11:15:37 am »
The solution is more difficult than I thought

#### paweld

• Hero Member
• Posts: 635
##### Re: VST summation time bugs
« Reply #11 on: February 05, 2023, 11:34:19 am »
you can add up the number of seconds (or minutes - depends on what details you need) and only at the end convert the time
Code: Pascal  [Select][+][-]
1. uses
2.   DateUtils;
3.
4. procedure TForm1.Button1Click(Sender: TObject);
5. var
6.   node: PVirtualNode;
7.   data: PData;
8.   sec: Integer = 0;
9. begin
10.   Node := VST.GetFirst();
11.   while Node <> nil do
12.   begin
13.     Data := VST.GetNodeData(Node);
14.     sec += SecondsBetween(0, Data^.Time);
15.     Node := VST.GetNext(Node);
16.   end;
17.   Label1.caption := 'Sum: ' + FormatDateTime('[h]:nn', (sec / SecsPerDay), [fdoInterval]);
18. end;
19.
Best regards / Pozdrawiam
paweld

#### wp

• Hero Member
• Posts: 10669
##### Re: VST summation time bugs
« Reply #12 on: February 06, 2023, 12:11:27 am »
I think I have a patch now. Before submitting, I would appreciate if you could check it. Since unit SysUtils is in the heart of the RTL the patching instructions are a bit complicated, though.
• If you are not experienced with rebuilding FPC you should make a backup copy of your FPC directory, just in case that something goes wrong. And we also need the backup as bootstrap compiler.
• Load the file rtl/objpas/sysutils.dati.inc into the IDE.
• Scroll down to the 2nd procedure DateTimeToString()
• Immediately before the nested procedure StoreFormat add the following code:
Code: Pascal  [Select][+][-]
2.   begin
5.     if (frac(ADateTime) > 0.9) and (Hour = 0) and (Minute = 0) and (Second = 0) and (Millisecond = 0) then
6.       inc(Result);
7.   end;
• Further down, there is a big case instruction: "case Token of". Inside the case "' ', 'C', 'D', 'H', 'M'...." there is another "case token of". Insiden this block there are four occurences of "if isInterval ...". After the "then" there is a call to "StoreInt(...)" which uses the expression "trunc(abs(DateTime))" in the argument. Replace this "trunc(...)" by "FullDays(DateTime)", replace for all occurences.
Code: Pascal  [Select][+][-]
1.             'M': begin
2.               if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
3.                 StoreInt(Minute + (Hour + FullDays(DateTime)*24)*60, 0)
4.               else
5. ...
6.             'H':
7.               if isInterval then
8.                 StoreInt(Hour + FullDays(DateTime)*24, Count)
9. ...
10.             'N': if isInterval then
11.                    StoreInt(Minute + (Hour + FullDays(DateTime)*24)*60, Count)
12.                  else
13. ...
14.             'S': if isInterval then
15.                    StoreInt(Second + (Minute + (Hour + FullDays(DateTime)*24)*60)*60, Count)
16.                  else
• Not related to your issue, there is another issue with negative time intervals. This can be fixed by adding the following code at the very end of the "DateTimeToString()" procedure, immediately before the "end;":
Code: Pascal  [Select][+][-]
1.   if (fdoInterval in Options) and (DateTime < 0) then
2.     Result := '-' + Result;
• Now you must recompile FPC. If you do not have experience with this (and since you seem to be on Windows) I'd recommend that you create a batch file "make_fpc.bat" with the following content and store it in the FPC directory. The batch file builds a 32-bit FPC, but can be easily modified to build a 64-bit FPC (see comments in the file). Important: Set the BINUTILS_DIR variable to the directory which contains the backup copy of your old FPC; this is required so that FPC finds all the tools to rebuild itself. The OPTIONS are for building a debug compiler allowing you to step into RTL and FCL units; make it an empty string ("") if you don't want this. Run the modified batch file from a console window; it will take some time until the new compiler is ready. If you have typos in the modified FormatDateTime code, compilation will abort - don't be confused by the success message at the end; you must scroll up the console outout a bit to see the faulty line(s) in the error message; correct the code and re-run the batch file.
Code: [Select]
`:: Batch file for building FPC 32-bit.:: For 64-bit replace "i386-win32" by "x86_64-win64" (two occurencies), :: and "ppc386.exe" by "ppcx64.exe"set BINUTILS_DIR=C:\Lazarus\fpc_backup\3.2.2\i386-win32set BOOTSTRAP_COMPILER=%BINUTILS_DIR%\ppc386.exeset FPC_DEST_DIR=c:\Lazarus\fpc-mainset BIN_DIR=bin\i386-win32set FPC_BIN_DIR=%FPC_DEST_DIR%\%BIN_DIR%set OPTIONS="-dDEBUG -gl -gw2"::------------------------------------------------------------------------------:: Set Path::------------------------------------------------------------------------------path %BINUTILS_DIR%;%PATH%::------------------------------------------------------------------------------:: Preparations::------------------------------------------------------------------------------md %FPC_BIN_DIR%copy %BINUTILS_DIR%\*.* %FPC_BIN_DIR% > nul:: Required - otherwise the script does not always work del /q /s %FPC_DEST_DIR%\units > nulrmdir /q /s %FPC_DEST_DIR%\units::------------------------------------------------------------------------------:: Build FPC::------------------------------------------------------------------------------make clean all install OPT=%OPTIONS% PREFIX=%FPC_DEST_DIR% FPC=%BOOTSTRAP_COMPILER%::------------------------------------------------------------------------------:: Make fpc.cfg, ::------------------------------------------------------------------------------cd %FPC_DEST_DIR%fpcmkcfg -d basepath=%FPC_DEST_DIR% -o %FPC_BIN_DIR%\fpc.cfg echo Compilation successful.`
• After rebuilding the IDE you can run the following test project. After each test the result "OK" should be printed in the console.
Code: Pascal  [Select][+][-]
1. program project2;
2.
3. uses
4.   SysUtils;
5.
6. procedure Test(ADateTime: TDateTime; AFormat: String; Expected: String);
7. var
8.   s: String;
9. begin
10.   s := FormatDateTime(AFormat, ADateTime, [fdoInterval]);
11.   Write(AFormat, ': ', ADateTime, ' ---> ');
12.   Write(s, ' (expected: ', Expected, ')');
13.   if Expected = s then
14.     WriteLn(' ---> OK')
15.   else
16.     WriteLn(' ---> ERROR');
17. end;
18.
19. var
20.   sum: TDateTime;
21.   i: Integer;
22.
23. begin
24.   Test(1/SecsPerDay, '[h]:nn:ss', '0:00:01');
25.   Test(0.5, '[h]:nn', '12:00');
26.   Test(0.75, '[h]:nn', '18:00');
27.   Test(0.9999999999999, '[h]:nn:ss', '24:00:00');
28.   Test(1.0000000000001, '[h]:nn:ss', '24:00:00');
29.   Test(-0.75,           '[h]:nn',    '-18:00');
30.   Test(-0.9999999999999, '[h]:nn:ss', '-24:00:00');
31.   Test(-1.0000000000001, '[h]:nn:ss', '-24:00:00');
32.
33.   // Accumulated worktime over 21 days, 8 hours per day:
34.   sum := 0.0;
35.   for i:=1 to 21 do
36.     sum := sum + 8/24;  // 8 hours
37.
38.   Test(sum, '[h]:nn:ss', IntToStr(21*8)+':00:00');
39.   Test(sum, '[h]:nn:ss.zzz', IntToStr(21*8)+':00:00.000');
40.
41.   WriteLn;
42.
43.   Test(1.0/24 - 0.05/MSecsPerDay, '[n]:ss', '60:00');
44.   Test(24/24-0.1/MSecsPerDay, '[n]:ss', IntToStr(24*60)+':00');
45.   Test(24/24+0.1/MSecsPerDay, '[n]:ss', IntToStr(24*60)+':00');
46.   Test(25/24-0.1/MSecsPerDay, '[n]:ss', IntToStr(25*60)+':00');
47.   Test(25/24+0.1/MSecsPerDay, '[n]:ss', IntToStr(25*60)+':00');
48.   Test(-1.0/24 - 0.05/MSecsPerDay, '[n]:ss', '-60:00');
49.   Test(-24/24-0.1/MSecsPerDay, '[n]:ss', IntToStr(-24*60)+':00');
50.   Test(-24/24+0.1/MSecsPerDay, '[n]:ss', IntToStr(-24*60)+':00');
51.   Test(-25/24-0.1/MSecsPerDay, '[n]:ss', IntToStr(-25*60)+':00');
52.   Test(-25/24+0.1/MSecsPerDay, '[n]:ss', IntToStr(-25*60)+':00');
53.
54.   WriteLn;
55.
56.   Test(1.0/24 - 0.05/MSecsPerDay, '[s]', '3600');
57.   Test(24/24-0.1/MSecsPerDay, '[s]', IntToStr(24*60*60));
58.   Test(24/24+0.1/MSecsPerDay, '[s]', IntToStr(24*60*60));
59.   Test(25/24-0.1/MSecsPerDay, '[s]', IntToStr(25*60*60));
60.   Test(25/24+0.1/MSecsPerDay, '[s]', IntToStr(25*60*60));
61.   Test(-1.0/24 - 0.05/MSecsPerDay, '[s]', '-3600');
62.   Test(-24/24-0.1/MSecsPerDay, '[s]', IntToStr(-24*60*60));
63.   Test(-24/24+0.1/MSecsPerDay, '[s]', IntToStr(-24*60*60));
64.   Test(-25/24-0.1/MSecsPerDay, '[s]', IntToStr(-25*60*60));
65.   Test(-25/24+0.1/MSecsPerDay, '[s]', IntToStr(-25*60*60));
66.
67.   WriteLn;
68.   Write('Press ENTER to close');
70. end.
« Last Edit: February 06, 2023, 12:15:01 am by wp »

#### Pe3s

• Sr. Member
• Posts: 380
##### Re: [SOLVED] VST summation time bugs
« Reply #13 on: February 06, 2023, 08:17:59 pm »
Thank you all for your help. The solution proposed by @paweld worked.

#### wp

• Hero Member
• Posts: 10669
##### Re: [SOLVED] VST summation time bugs
« Reply #14 on: February 06, 2023, 11:49:18 pm »