From 70a178c88e3d7c1d776cc65eacad94d93d9764a4 Mon Sep 17 00:00:00 2001
From: Bart <9132501-flyingsheep@users.noreply.gitlab.com>
Date: Tue, 1 Aug 2023 11:44:25 +0200
Subject: [PATCH] TaskDialog: add OnTimer event.

---
 lcl/dialogs.pp                         |  4 +++
 lcl/interfaces/win32/win32wsdialogs.pp | 16 +++++++--
 lcl/taskdlgemulation.pp                | 45 +++++++++++++++++++++++++-
 3 files changed, 62 insertions(+), 3 deletions(-)

diff --git a/lcl/dialogs.pp b/lcl/dialogs.pp
index 5b8c6da642..cf734bc51b 100644
--- a/lcl/dialogs.pp
+++ b/lcl/dialogs.pp
@@ -552,6 +552,7 @@ type
   TTaskDialogCommonButtons = set of TTaskDialogCommonButton;
 
   TTaskDlgClickEvent = procedure(Sender: TObject; AModalResult: TModalResult; var ACanClose: Boolean) of object;
+  TTaskDlgTimerEvent = procedure(Sender: TObject; TickCount: Cardinal; var Reset: Boolean) of object;
 
   TTaskDialogIcon = (tdiNone, tdiWarning, tdiError, tdiInformation, tdiShield, tdiQuestion);
 
@@ -639,6 +640,7 @@ type
     FOnDialogCreated: TNotifyEvent;
     FOnDialogDestroyed: TNotifyEvent;
     FOnExpand: TNotifyEvent;
+    FOnTimer: TTaskDlgTimerEvent;
     FOnVerificationClicked: TNotifyEvent;
     FQueryChoices: TStrings;
     FQueryResult: String;
@@ -695,6 +697,7 @@ type
     property OnDialogDestroyed: TNotifyEvent read FOnDialogDestroyed write FOnDialogDestroyed;
     property OnVerificationClicked: TNotifyEvent read FOnVerificationClicked write FOnVerificationClicked;
     property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
+    property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer;
   end;
 
   TTaskDialog = class(TCustomTaskDialog)
@@ -724,6 +727,7 @@ type
     property OnDialogDestroyed;
     property OnVerificationClicked;
     property OnExpand;
+    property OnTimer;
   end;
 
 const
diff --git a/lcl/interfaces/win32/win32wsdialogs.pp b/lcl/interfaces/win32/win32wsdialogs.pp
index 47b41c276e..0f78a06726 100644
--- a/lcl/interfaces/win32/win32wsdialogs.pp
+++ b/lcl/interfaces/win32/win32wsdialogs.pp
@@ -1656,7 +1656,7 @@ end;
 function TaskDialogCallbackProc(hwnd: HWND; uNotification: UINT;
   wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall;
 var Dlg: TTaskDialog absolute dwRefData;
-    CanClose: Boolean;
+    CanClose, ResetTimer: Boolean;
 begin
   Result := S_OK;
   case uNotification of
@@ -1699,7 +1699,19 @@ begin
     end;
     TDN_TIMER:
     begin
-      if IsConsole then writeln('ToDo: implement OnTimer');
+      {
+      wParam: A DWORD that specifies the number of milliseconds since the dialog was created or this notification code returned S_FALSE.
+      lParam: Must be zero.
+      Return value: To reset the tickcount, the application must return S_FALSE, otherwise the tickcount will continue to increment.
+      }
+      Assert((Dlg is TCustomTaskDialog),'TaskDialogCallbackProc: dwRefData is NOT a TCustomTaskDialog');
+      if Assigned(Dlg.OnTimer) then
+      begin
+        ResetTimer := False;
+        Dlg.OnTimer(Dlg, Cardinal(wParam), ResetTimer);
+        if ResetTimer then
+          Result := S_FALSE;
+      end;
     end;
     TDN_VERIFICATION_CLICKED:
     begin
diff --git a/lcl/taskdlgemulation.pp b/lcl/taskdlgemulation.pp
index 5106e447e1..5dcbf11962 100644
--- a/lcl/taskdlgemulation.pp
+++ b/lcl/taskdlgemulation.pp
@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils,
   LazUTF8,
-  LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc,
+  LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc, DateUtils,
   LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes;
 
 
@@ -25,6 +25,8 @@ type
     /// the Task Dialog structure which created the form
     FDlg: TTaskDialog;
     FVerifyChecked: Boolean;
+    Timer: TTimer;
+    TimerStartTime: TTime;
     RadioButtonArray: array of TRadioButton;
 
     //CustomButtons, Radios: TStringList;
@@ -53,6 +55,9 @@ type
     function AddLabel(const AText: string; BigFont: boolean; var X, Y: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel;
     procedure AddQueryCombo(var X,Y: Integer; AWidth: Integer; AParent: TWinControl);
     procedure AddQueryEdit(var X,Y: Integer; AWidth: Integer; AParent: TWinControl);
+    procedure OnTimer(Sender: TObject);
+    procedure SetupTimer;
+    procedure ResetTimer;
 
     procedure DoDialogConstructed;
     procedure DoDialogCreated;
@@ -651,6 +656,41 @@ begin
   inc(Y,42);
 end;
 
+procedure TLCLTaskDialog.OnTimer(Sender: TObject);
+var
+  AResetTimer: Boolean;
+  MSecs: Cardinal;
+  MSecs64: Int64;
+begin
+  if Assigned(FDlg.OnTimer) then
+  begin
+    MSecs64 := MilliSecondsBetween(Now, TimerStartTime);
+    {$PUSH}{$R-}
+    MSecs := MSecs64;
+    {$POP}
+    AResetTimer := False;
+    FDlg.OnTimer(FDlg, MSecs, AResetTimer);
+    if AResetTimer then
+      ResetTimer;
+  end;
+end;
+
+procedure TLCLTaskDialog.SetupTimer;
+begin
+  Timer := TTimer.Create(Self);
+  Timer.Interval := 200; //source: https://learn.microsoft.com/en-us/windows/win32/controls/tdn-timer
+  Timer.OnTimer := @OnTimer;
+  TimerStartTime := Now;
+  Timer.Enabled := True;
+end;
+
+procedure TLCLTaskDialog.ResetTimer;
+begin
+  Timer.Enabled := False;
+  TimerStartTime := Now;
+  Timer.Enabled := True;
+end;
+
 procedure TLCLTaskDialog.DoDialogConstructed;
 begin
   if Assigned(FDlg.OnDialogConstructed) then
@@ -834,6 +874,9 @@ begin
     AddFooter(X, Y, XB, FontHeight, aWidth, CurrParent);
 
    ClientHeight := Y;
+
+   if (tfCallBackTimer in FDlg.Flags) then
+     SetupTimer;
 end;
 
 procedure TLCLTaskDialog.KeyDown(var Key: Word; Shift: TShiftState);