Bladeren bron

Merge branch 'taskdialog' into compiler-update

Martijn Laan 6 jaren geleden
bovenliggende
commit
32347a74f1

+ 23 - 1
Examples/CodeClasses.iss

@@ -77,10 +77,23 @@ begin
   end;
 end;
 
+procedure TaskDialogButtonOnClick(Sender: TObject);
+begin
+  //TaskDialogMsgBox isn't a class but showing it anyway since it fits with the theme
+  case TaskDialogMsgBox('Choose A or B',
+                        'You can choose A or B.', 'You can choose A or B'#13#10#13#10'Do you choose A?',   
+                        mbInformation,
+                        MB_YESNOCANCEL, ['I choose A'#13#10'A will be chosen.', 'I choose B'#13#10'B will be chosen.'],
+                        IDYES, False) of
+    IDYES: MsgBox('You chose A.', mbInformation, MB_OK);
+    IDNO: MsgBox('You chose B.', mbInformation, MB_OK);
+  end;
+end;
+
 procedure CreateTheWizardPages;
 var
   Page: TWizardPage;
-  Button, FormButton: TNewButton;
+  Button, FormButton, TaskDialogButton: TNewButton;
   Panel: TPanel;
   CheckBox: TNewCheckBox;
   Edit: TNewEdit;
@@ -153,6 +166,15 @@ begin
   FormButton.OnClick := @FormButtonOnClick;
   FormButton.Parent := Page.Surface;
 
+  TaskDialogButton := TNewButton.Create(Page);
+  TaskDialogButton.Top := FormButton.Top;
+  TaskDialogButton.Left := FormButton.Left + FormButton.Width + ScaleX(8);
+  TaskDialogButton.Width := ScaleX(110);
+  TaskDialogButton.Height := ScaleY(23);
+  TaskDialogButton.Caption := 'TaskDialogMsgBox';
+  TaskDialogButton.OnClick := @TaskDialogButtonOnClick;
+  TaskDialogButton.Parent := Page.Surface;
+
   { TComboBox and others }
 
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TComboBox and others');

+ 9 - 2
Files/Default.isl

@@ -65,8 +65,15 @@ SetupAppRunningError=Setup has detected that %1 is currently running.%n%nPlease
 UninstallAppRunningError=Uninstall has detected that %1 is currently running.%n%nPlease close all instances of it now, then click OK to continue, or Cancel to exit.
 
 ; *** Startup questions
-PrivilegesRequiredOverrideMsgBox1=This program can be installed for all users (recommended, but requires administrative privileges), or only for yourself.%n%nInstall for all users?
-PrivilegesRequiredOverrideMsgBox2=This program can be installed only for yourself (recommended), or for all users (requires administrative privileges).%n%nInstall only for yourself?
+PrivilegesRequiredOverrideInstruction=Choose install mode
+PrivilegesRequiredOverrideThisProgram=This program
+PrivilegesRequiredOverrideTaskDialogText1=%1 can be installed for all users (requires administrative privileges), or for you only.
+PrivilegesRequiredOverrideMsgBoxText1=%1 can be installed for all users (recommended, but requires administrative privileges), or for you only.%n%nInstall for all users?
+PrivilegesRequiredOverrideTaskDialogText2=%1 can be installed for you only, or for all users (requires administrative privileges).
+PrivilegesRequiredOverrideMsgBoxText2=%1 can be installed for you only (recommended), or for all users (requires administrative privileges).%n%nInstall for you only?
+PrivilegesRequiredOverrideAllUsers=Install for all users
+PrivilegesRequiredOverrideCurrentUser=Install for me only
+PrivilegesRequiredOverrideRecommended=%1 (recommended)
 
 ; *** Misc. errors
 ErrorCreatingDir=Setup was unable to create the directory "%1"

+ 9 - 2
Files/Languages/Dutch.isl

@@ -48,8 +48,15 @@ SetupAppRunningError=Setup heeft vastgesteld dat %1 op dit moment actief is.%n%n
 UninstallAppRunningError=Het verwijderprogramma heeft vastgesteld dat %1 op dit moment actief is.%n%nSluit alle vensters hiervan, en klik daarna op OK om verder te gaan, of op Annuleren om het verwijderen af te breken.
 
 ; *** Startup questions
-PrivilegesRequiredOverrideMsgBox1=Dit programma kan geïnstalleerd worden voor alle gebruikers (aanbevolen, maar vereist aanmelding als een systeembeheerder), of voor alleen de huidige gebruiker.%n%nWilt u voor alle gebruikers installeren?
-PrivilegesRequiredOverrideMsgBox2=Dit programma kan geïnstalleerd worden voor alleen de huidige gebruiker (aanbevolen), of voor alle gebruikers (vereist aanmelding als een systeembeheerder).%n%nWilt u voor alleen de huidige gebruiker installeren?
+PrivilegesRequiredOverrideInstruction=Kies installatie modus
+PrivilegesRequiredOverrideThisProgram=Dit programma
+PrivilegesRequiredOverrideTaskDialogText1=%1 kan geïnstalleerd worden voor alle gebruikers (vereist aanmelding als een systeembeheerder), of voor u alleen.
+PrivilegesRequiredOverrideMsgBoxText1=%1 kan geïnstalleerd worden voor alle gebruikers (aanbevolen, maar vereist aanmelding als een systeembeheerder), of voor u alleen.%n%nWilt u voor alle gebruikers installeren?
+PrivilegesRequiredOverrideTaskDialogText2=%1 kan geïnstalleerd worden voor u alleen, of voor alle gebruikers (vereist aanmelding als een systeembeheerder).
+PrivilegesRequiredOverrideMsgBoxText2=%1 kan geïnstalleerd worden voor u alleen (aanbevolen), of voor alle gebruikers (vereist aanmelding als een systeembeheerder).%n%nWilt u voor u alleen installeren?
+PrivilegesRequiredOverrideAllUsers=Installeer voor alle gebruikers
+PrivilegesRequiredOverrideCurrentUser=Installeer voor mij alleen
+PrivilegesRequiredOverrideRecommended=%1 (aanbevolen)
 
 ; *** Misc. errors
 ErrorCreatingDir=Setup kan de map "%1" niet maken

+ 4 - 4
ISHelp/isetup.xml

@@ -3205,7 +3205,7 @@ Filename: "{win}\MYPROG.INI"; Section: "InstallSettings"; Key: "InstallPath"; St
 <li>The Exit Setup? message box.</li>
 <li>The FileNotInDir2 message box displayed when Setup requires a new disk to be inserted and the disk was not found.</li>
 <li>Any (error) message box displayed before Setup (or Uninstall) could read the command line parameters.</li>
-<li>Any message box displayed by [Code] support function <tt>MsgBox</tt>.</li>
+<li>Any task dialog or message box displayed by [Code] support functions <tt>TaskDialogMsgBox</tt> and <tt>MsgBox</tt>.</li>
 </ul>
 </dd>
 
@@ -3958,13 +3958,13 @@ Name: portablemode; Description: "Portable Mode"</pre></example>
 
 <setuptopic directive="PrivilegesRequiredOverridesAllowed">
 <keyword value="commandline" />
-<keyword value="msgbox" />
-<setupvalid>One or more of the following, separated by spaces: <br/><tt>commandline</tt> <br/><tt>msgbox</tt></setupvalid>
+<keyword value="dialog" />
+<setupvalid>One or more of the following, separated by spaces: <br/><tt>commandline</tt> <br/><tt>dialog</tt></setupvalid>
 <setupdefault><i>(blank)</i></setupdefault>
 <body>
 <p>Can be set to one or more overrides which allow the end user to override the script's default <link topic="setup_privilegesrequired">PrivilegesRequired</link> setting.</p>
 <p>If override <tt>commandline</tt> is allowed then Setup will support two additional command line parameters to override the script's default <link topic="setup_privilegesrequired">PrivilegesRequired</link> setting: /ALLUSERS and /CURRENTUSER. See <link topic="setupcmdline" anchor="ALLUSERS">Setup Command Line Parameters</link> for more details.</p>
-<p>If override <tt>msgbox</tt> is allowed then Setup will ask the user whether administrative or non administrative install mode should be used based on the script's default <link topic="setup_privilegesrequired">PrivilegesRequired</link> setting. Allowing <tt>msgbox</tt> automatically allows <tt>commandline</tt> and when one of the command line parameters is used then Setup will not ask the user.</p>
+<p>If override <tt>dialog</tt> is allowed then Setup will ask the user to choose the install mode based on the script's default <link topic="setup_privilegesrequired">PrivilegesRequired</link> setting using a suppressible dialog. Allowing <tt>dialog</tt> automatically allows <tt>commandline</tt> and when one of the command line parameters is used then Setup will not ask the user.</p>
 </body>
 </setuptopic>
 

+ 49 - 2
ISHelp/isxfunc.xml

@@ -2329,9 +2329,13 @@ end;</pre></example>
       <function>
         <name>MsgBox</name>
         <prototype>function MsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons: Integer): Integer;</prototype>
-        <description><p>Displays a message box. <tt>Text</tt> specifies the message to display. <tt>Typ</tt> specifies which icon to use in the message box. <tt>Buttons</tt> specifies which buttons to include in the message box. Returns an ID* constant indicating the button the user clicked, or 0 if the function fails (which shouldn't happen unless an invalid parameter is specified or system resources are exhausted).</p></description>
+        <description><p>Displays a message box. <tt>Text</tt> specifies the message to display. <tt>Typ</tt> specifies which icon to display in the message box. <tt>Buttons</tt> specifies which buttons to include in the message box. Returns an ID* constant indicating the button the user clicked, or 0 if the function fails (which shouldn't happen unless an invalid parameter is specified or system resources are exhausted).</p></description>
         <remarks><p>TMsgBoxType is defined as:</p>
-<p><tt>TMsgBoxType = (mbInformation, mbConfirmation, mbError, mbCriticalError);</tt></p></remarks>
+<p><tt>TMsgBoxType = (mbInformation, mbConfirmation, mbError, mbCriticalError);</tt></p>
+<p>Supported flags for <tt>Buttons</tt> are:</p>
+<p><tt>MB_OK, MB_OKCANCEL, MB_ABORTRETRYIGNORE, MB_YESNOCANCEL, MB_YESNO, MB_RETRYCANCEL, MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_SETFOREGROUND</tt></p>
+<p>Possible return values are:</p>
+<p><tt>IDOK, IDCANCEL, IDABORT, IDRETRY, IDIGNORE, IDYES, IDNO</tt></p></remarks>
         <example><pre>begin
   // Display a simple message box with an OK button
   MsgBox('Hello.', mbInformation, MB_OK);
@@ -2348,12 +2352,55 @@ end;</pre></example>
     // user clicked Yes
   end;
 end;</pre></example>
+        <seealso><p><link topic="isxfunc_SuppressibleMsgBox">SuppressibleMsgBox</link><br />
+<link topic="isxfunc_TaskDialogMsgBox">TaskDialogMsgBox</link></p></seealso>
       </function>
       <function>
         <name>SuppressibleMsgBox</name>
         <prototype>function SuppressibleMsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons, Default: Integer): Integer;</prototype>
         <description><p>Displays a suppressible message box. If message boxes are being suppressed (see <link topic="setupcmdline" window="main">Setup Command Line Parameters</link>), <tt>Default</tt> is returned. Otherwise, SuppressibleMsgBox acts the same as the regular <link topic="isxfunc_MsgBox">MsgBox</link>.</p></description>
       </function>
+      <function>
+        <name>TaskDialogMsgBox</name>
+        <prototype>function TaskDialogMsgBox(const Instruction, TaskDialogText, MsgBoxText: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: TArrayOfString; const ShieldButton: Integer; const ForceMsgBox: Boolean): Integer;</prototype>
+        <description><p>Displays a task dialog if supported by the system and <tt>ForceMsgBox</tt> is set to <tt>False</tt>. Otherwise, displays a regular message box.</p>
+<p>If a task dialog is displayed:<br />
+<tt>Instruction</tt> specifies the instruction to display.<br />
+<tt>TaskDialogText</tt> specifies the message to display.<br />
+<tt>Typ</tt> specifies which icon to display in the task dialog. If set to <tt>mbConfirmation</tt>, no icon will be displayed.<br />
+<tt>Buttons</tt> specifies which buttons to include in the task dialog.<br />
+<tt>ButtonLabels</tt> specifies which custom button labels to use. If set to an empty array, the system's default button labels will be used. If a label consists of two strings separated by a newline, then the first string specifies the button label and the second string specifies the button note.<br />
+<tt>ShieldButton</tt> specifies which button to display a shield icon on. If set to 0, no shield icon will be displayed.</p>
+<p>If a a regular message box is displayed:<br/>
+<tt>Instruction</tt> specifies the caption to display. If set to an empty string, the default caption will be displayed.<br />
+<tt>MsgBoxText</tt> specifies the message to display.<br />
+<tt>Typ</tt> specifies which icon to display in the message box.<br />
+<tt>Buttons</tt> specifies which buttons to include in the message box.</p>
+<p>Returns an ID* constant indicating the button the user clicked, or 0 if the function fails (which shouldn't happen unless an invalid parameter is specified or system resources are exhausted).</p></description>
+        <remarks><p>TMsgBoxType is defined as:</p>
+<p><tt>TMsgBoxType = (mbInformation, mbConfirmation, mbError, mbCriticalError);</tt></p>
+<p>Supported flags for <tt>Buttons</tt> are:</p>
+<p><tt>MB_OK, MB_OKCANCEL, MB_YESNOCANCEL, MB_YESNO, MB_RETRYCANCEL</tt></p>
+<p>Supported values for <tt>ShieldButton</tt> and possible return values are:</p>
+<p><tt>IDOK, IDCANCEL, IDRETRY, IDYES, IDNO</tt></p></remarks>
+        <example><pre>begin
+  case TaskDialogMsgBox('Choose A or B',
+                        'You can choose A or B.', 'You can choose A or B'#13#10#13#10'Do you choose A?',   
+                        mbInformation,
+                        MB_YESNOCANCEL, ['I choose A'#13#10'A will be chosen.', 'I choose B'#13#10'B will be chosen.'],
+                        IDYES, False) of
+    IDYES: MsgBox('You chose A.', mbInformation, MB_OK);
+    IDNO: MsgBox('You chose B.', mbInformation, MB_OK);
+  end;
+end;</pre></example>
+        <seealso><p><link topic="isxfunc_SuppressibleTaskDialogMsgBox">SuppressibleTaskDialogMsgBox</link><br />
+<link topic="isxfunc_MsgBox">MsgBox</link></p></seealso>
+      </function>
+      <function>
+        <name>SuppressibleTaskDialogMsgBox</name>
+        <prototype>function SuppressibleTaskDialogMsgBox(const Instruction, TaskDialogText, MsgBoxText: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: TArrayOfString; const ShieldButton: Integer; const ForceMsgBox: Boolean; const Default: Integer): Integer;</prototype>
+        <description><p>Displays a suppressible task dialog. If message boxes are being suppressed (see <link topic="setupcmdline" window="main">Setup Command Line Parameters</link>), <tt>Default</tt> is returned. Otherwise, SuppressibleTaskDialogMsgBox acts the same as the regular <link topic="isxfunc_TaskDialogMsgBox">TaskDialogMsgBox</link>.</p></description>
+      </function>
       <function>
         <name>GetOpenFileName</name>
         <prototype>function GetOpenFileName(const Prompt: String; var FileName: String; const InitialDirectory, Filter, DefaultExtension: String): Boolean;</prototype>

+ 53 - 41
Projects/CmnFunc.pas

@@ -51,8 +51,11 @@ function MsgBoxFmt(const Text: String; const Args: array of const;
   const Caption: String; const Typ: TMsgBoxType; const Buttons: Cardinal): Integer;
 procedure ReactivateTopWindow;
 procedure SetMessageBoxCaption(const Typ: TMsgBoxType; const NewCaption: PChar);
+function GetMessageBoxCaption(const Caption: PChar; const Typ: TMsgBoxType): PChar;
 procedure SetMessageBoxRightToLeft(const ARightToLeft: Boolean);
+function GetMessageBoxRightToLeft: Boolean;
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
+procedure TriggerMessageBoxCallbackFunc(const Flags: LongInt; const After: Boolean);
 
 implementation
 
@@ -165,11 +168,42 @@ begin
     MessageBoxCaptions[Typ] := StrNew(NewCaption);
 end;
 
+function GetMessageBoxCaption(const Caption: PChar; const Typ: TMsgBoxType): PChar;
+const
+  {$IFNDEF Delphi3orHigher}
+  DefaultCaptions: array[TMsgBoxType] of Word =
+    (SMsgDlgInformation, SMsgDlgConfirm, SMsgDlgError, SMsgDlgError);
+  {$ELSE}
+  DefaultCaptions: array[TMsgBoxType] of Pointer =
+    (@SMsgDlgInformation, @SMsgDlgConfirm, @SMsgDlgError, @SMsgDlgError);
+  {$ENDIF}
+var
+  NewCaption: String;
+begin
+  Result := Caption;
+  if (Result = nil) or (Result[0] = #0) then begin
+    Result := MessageBoxCaptions[Typ];
+    if Result = nil then begin
+      {$IFNDEF Delphi3orHigher}
+      NewCaption := LoadStr(DefaultCaptions[Typ]);
+      {$ELSE}
+      NewCaption := LoadResString(DefaultCaptions[Typ]);
+      {$ENDIF}
+      Result := PChar(NewCaption);
+    end;
+  end;
+end;
+
 procedure SetMessageBoxRightToLeft(const ARightToLeft: Boolean);
 begin
   MessageBoxRightToLeft := ARightToLeft;
 end;
 
+function GetMessageBoxRightToLeft: Boolean;
+begin
+  Result := MessageBoxRightToLeft;
+end;
+
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
 begin
   MessageBoxCallbackFunc := AFunc;
@@ -248,26 +282,26 @@ begin
   if MessageBoxRightToLeft then
     Flags := Flags or (MB_RTLREADING or MB_RIGHT);
 
-  { If the application window isn't currently visible, show the message box
-    with no owner window so it'll get a taskbar button } 
-  if IsIconic(Application.Handle) or
-     (GetWindowLong(Application.Handle, GWL_STYLE) and WS_VISIBLE = 0) or
-     (GetWindowLong(Application.Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW <> 0) then begin
-    ActiveWindow := GetActiveWindow;
-    WindowList := DisableTaskWindows(0);
-    try
-      { Note: DisableTaskWindows doesn't disable invisible windows.
-        MB_TASKMODAL will ensure that Application.Handle gets disabled too. }
-      Result := MessageBox(0, Text, Caption, Flags or MB_TASKMODAL);
-    finally
-      EnableTaskWindows(WindowList);
-      SetActiveWindow(ActiveWindow);
-    end;
-    Exit;
-  end;
-
   TriggerMessageBoxCallbackFunc(Flags, False);
   try
+    { If the application window isn't currently visible, show the message box
+      with no owner window so it'll get a taskbar button } 
+    if IsIconic(Application.Handle) or
+       (GetWindowLong(Application.Handle, GWL_STYLE) and WS_VISIBLE = 0) or
+       (GetWindowLong(Application.Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW <> 0) then begin
+      ActiveWindow := GetActiveWindow;
+      WindowList := DisableTaskWindows(0);
+      try
+        { Note: DisableTaskWindows doesn't disable invisible windows.
+          MB_TASKMODAL will ensure that Application.Handle gets disabled too. }
+        Result := MessageBox(0, Text, Caption, Flags or MB_TASKMODAL);
+      finally
+        EnableTaskWindows(WindowList);
+        SetActiveWindow(ActiveWindow);
+      end;
+      Exit;
+    end;
+
 {$IFDEF IS_D4}
     { On Delphi 4+, simply call Application.MessageBox }
     Result := Application.MessageBox(Text, Caption, Flags);
@@ -303,30 +337,8 @@ function MsgBoxP(const Text, Caption: PChar; const Typ: TMsgBoxType;
 const
   IconFlags: array[TMsgBoxType] of Cardinal =
     (MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONEXCLAMATION, MB_ICONSTOP);
-  {$IFNDEF Delphi3orHigher}
-  DefaultCaptions: array[TMsgBoxType] of Word =
-    (SMsgDlgInformation, SMsgDlgConfirm, SMsgDlgError, SMsgDlgError);
-  {$ELSE}
-  DefaultCaptions: array[TMsgBoxType] of Pointer =
-    (@SMsgDlgInformation, @SMsgDlgConfirm, @SMsgDlgError, @SMsgDlgError);
-  {$ENDIF}
-var
-  C: PChar;
-  NewCaption: String;
 begin
-  C := Caption;
-  if (C = nil) or (C[0] = #0) then begin
-    C := MessageBoxCaptions[Typ];
-    if C = nil then begin
-      {$IFNDEF Delphi3orHigher}
-      NewCaption := LoadStr(DefaultCaptions[Typ]);
-      {$ELSE}
-      NewCaption := LoadResString(DefaultCaptions[Typ]);
-      {$ENDIF}
-      C := PChar(NewCaption);
-    end;
-  end;
-  Result := AppMessageBox(Text, C, Buttons or IconFlags[Typ]);
+  Result := AppMessageBox(Text, GetMessageBoxCaption(Caption, Typ), Buttons or IconFlags[Typ]);
 end;
 
 function MsgBox(const Text, Caption: String; const Typ: TMsgBoxType;

+ 9 - 6
Projects/Compile.pas

@@ -3705,7 +3705,7 @@ var
 
   function StrToPrivilegesRequiredOverrides(S: String): TSetupPrivilegesRequiredOverrides;
   const
-    Overrides: array[0..1] of PChar = ('commandline', 'msgbox');
+    Overrides: array[0..1] of PChar = ('commandline', 'dialog');
   begin
     Result := [];
     while True do
@@ -3713,7 +3713,7 @@ var
         -2: Break;
         -1: Invalid;
         0: Include(Result, proCommandLine);
-        1: Result := Result + [proCommandLine, proMsgBox];
+        1: Result := Result + [proCommandLine, proDialog];
       end;
   end;
 var
@@ -8632,10 +8632,13 @@ begin
       AbortCompile(SCompilerAppVersionOrAppVerNameRequired);
     LineNumber := SetupDirectiveLines[ssAppName];
     AppNameHasConsts := CheckConst(SetupHeader.AppName, SetupHeader.MinVersion, []);
-    if AppNameHasConsts and not(shDisableStartupPrompt in SetupHeader.Options) then begin
-      { AppName has contants so DisableStartupPrompt must be used }
-      LineNumber := SetupDirectiveLines[ssDisableStartupPrompt];
-      AbortCompile(SCompilerMustUseDisableStartupPrompt);
+    if AppNameHasConsts then begin
+      Include(SetupHeader.Options, shAppNameHasConsts);
+      if not(shDisableStartupPrompt in SetupHeader.Options) then begin
+        { AppName has contants so DisableStartupPrompt must be used }
+        LineNumber := SetupDirectiveLines[ssDisableStartupPrompt];
+        AbortCompile(SCompilerMustUseDisableStartupPrompt);
+      end;
     end;
     if SetupHeader.AppId = '' then
       SetupHeader.AppId := SetupHeader.AppName

+ 61 - 17
Projects/Main.pas

@@ -220,6 +220,9 @@ function LoggedAppMessageBox(const Text, Caption: PChar; const Flags: Longint;
   const Suppressible: Boolean; const Default: Integer): Integer;
 function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
   const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
+function LoggedTaskDialogMsgBox(const Icon, Instruction, TaskDialogText, MsgBoxText, Caption: String;
+  const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
+  const ShieldButton: Integer; const ForceMsgBox: Boolean; const Suppressible: Boolean; const Default: Integer): Integer;
 procedure LogWindowsVersion;
 procedure NotifyAfterInstallEntry(const AfterInstall: String);
 procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
@@ -255,7 +258,8 @@ uses
   Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
   Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
   {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
-  SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion, BitmapImage;
+  SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion, BitmapImage,
+  TaskDialog;
 
 {$R *.DFM}
 
@@ -2373,6 +2377,24 @@ begin
   end;
 end;
 
+function LoggedTaskDialogMsgBox(const Icon, Instruction, TaskDialogText, MsgBoxText, Caption: String;
+  const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String;
+  const ShieldButton: Integer; const ForceMsgBox: Boolean; const Suppressible: Boolean; const Default: Integer): Integer;
+begin
+  if InitSuppressMsgBoxes and Suppressible then begin
+    LogSuppressedMessageBox(PChar(TaskDialogText), Buttons, Default);
+    Result := Default;
+  end else begin
+    LogMessageBox(PChar(TaskDialogText), Buttons);
+    Result := TaskDialogMsgBox(Icon, Instruction, TaskDialogText, MsgBoxText,
+      Caption, Typ, Buttons, ButtonLabels, ShieldButton, ForceMsgBox);
+    if Result <> 0 then
+      LogFmt('User chose %s.', [GetMessageBoxResultText(Result)])
+    else
+      Log('TaskDialogMsgBox failed.');
+  end;
+end;
+
 procedure RestartComputerFromThisProcess;
 begin
   RestartInitiatedByThisProcess := True;
@@ -2769,7 +2791,7 @@ var
   LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
   MinimumTypeSpace: Integer64;
   SourceWildcard: String;
-  ExpandedSetupMutex, ExtraRespawnParam, RespawnParams: String;
+  ExpandedSetupMutex, AppName, ExtraRespawnParam, RespawnParams: String;
 begin
   InitializeCommonVars;
 
@@ -2967,24 +2989,46 @@ begin
         { Apply InitPrivilegesRequired }
         if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then
           SetupHeader.PrivilegesRequired := InitPrivilegesRequired
-        else if not InitSuppressMsgBoxes and (proMsgBox in SetupHeader.PrivilegesRequiredOverridesAllowed) then begin
+        else if not InitSuppressMsgBoxes and (proDialog in SetupHeader.PrivilegesRequiredOverridesAllowed) then begin
           { Ask user. Doesn't log since logging hasn't started yet. Also doesn't use ExpandedAppName since it isn't set yet.
-            Afterwards we need to tell the respawned Setup about the user choice. Will use the command line parameter for
-            this. Allowing proMsgBox forces allowing proCommandLine, so we can count on the parameter to work. }
+            Afterwards we need to tell the respawned Setup about the user choice (and avoid it asking agin). Will use the
+            command line parameter for this. Allowing proDialog forces allowing proCommandLine, so we can count on the parameter to work. }
+          if shAppNameHasConsts in SetupHeader.Options then
+            AppName := SetupMessages[msgPrivilegesRequiredOverrideThisProgram]
+          else
+            AppName := SetupHeader.AppName;          
           if SetupHeader.PrivilegesRequired = prLowest then begin
-            if MsgBox(SetupMessages[msgPrivilegesRequiredOverrideMsgBox2],
-              SetupMessages[msgSetupAppTitle], mbInformation, MB_YESNO) <> IDYES then begin
-               SetupHeader.PrivilegesRequired := prAdmin;
-               ExtraRespawnParam := '/ALLUSERS';
-            end else
-               ExtraRespawnParam := '/CURRENTUSER';
+            case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
+                   FmtSetupMessage(msgPrivilegesRequiredOverrideTaskDialogText2, [AppName]),
+                   FmtSetupMessage(msgPrivilegesRequiredOverrideMsgBoxText2, [AppName]),
+                   SetupMessages[msgSetupAppTitle], mbInformation, MB_YESNOCANCEL,
+                   [FmtSetupMessage(msgPrivilegesRequiredOverrideRecommended, [SetupMessages[msgPrivilegesRequiredOverrideCurrentUser]]), SetupMessages[msgPrivilegesRequiredOverrideAllUsers]], IDNO, False) of
+              IDYES:
+                ExtraRespawnParam := '/CURRENTUSER';
+              IDNO:
+                begin
+                  SetupHeader.PrivilegesRequired := prAdmin;
+                  ExtraRespawnParam := '/ALLUSERS';
+                end;
+              IDCANCEL:
+                Abort;
+              end;
           end else begin
-            if MsgBox(SetupMessages[msgPrivilegesRequiredOverrideMsgBox1],
-              SetupMessages[msgSetupAppTitle], mbInformation, MB_YESNO) <> IDYES then begin
-               SetupHeader.PrivilegesRequired := prLowest;
-               ExtraRespawnParam := '/CURRENTUSER';
-             end else
-               ExtraRespawnParam := '/ALLUSERS';
+            case TaskDialogMsgBox('MAINICON', SetupMessages[msgPrivilegesRequiredOverrideInstruction],
+                   FmtSetupMessage(msgPrivilegesRequiredOverrideTaskDialogText1, [AppName]),
+                   FmtSetupMessage(msgPrivilegesRequiredOverrideMsgBoxText1, [AppName]),
+                   SetupMessages[msgSetupAppTitle], mbInformation, MB_YESNOCANCEL,
+                   [FmtSetupMessage(msgPrivilegesRequiredOverrideRecommended, [SetupMessages[msgPrivilegesRequiredOverrideAllUsers]]), SetupMessages[msgPrivilegesRequiredOverrideCurrentUser]], IDYES, False) of
+              IDYES:
+                ExtraRespawnParam := '/ALLUSERS';
+              IDNO:
+                begin
+                  SetupHeader.PrivilegesRequired := prLowest;
+                  ExtraRespawnParam := '/CURRENTUSER';
+                end;
+              IDCANCEL:
+                Abort;
+            end;
           end;
         end;
 

+ 9 - 2
Projects/MsgIDs.pas

@@ -146,8 +146,15 @@ type
     msgPowerUserPrivilegesRequired,
     msgPreparingDesc,
     msgPreviousInstallNotCompleted,
-    msgPrivilegesRequiredOverrideMsgBox1,
-    msgPrivilegesRequiredOverrideMsgBox2,
+    msgPrivilegesRequiredOverrideInstruction,
+    msgPrivilegesRequiredOverrideThisProgram,
+    msgPrivilegesRequiredOverrideTaskDialogText1,
+    msgPrivilegesRequiredOverrideMsgBoxText1,
+    msgPrivilegesRequiredOverrideTaskDialogText2,
+    msgPrivilegesRequiredOverrideMsgBoxText2,
+    msgPrivilegesRequiredOverrideAllUsers,
+    msgPrivilegesRequiredOverrideCurrentUser,
+    msgPrivilegesRequiredOverrideRecommended,
     msgReadyLabel1,
     msgReadyLabel2a,
     msgReadyLabel2b,

+ 5 - 3
Projects/ScriptFunc.pas

@@ -47,9 +47,8 @@ const
   );
 
   { CmnFunc }
-  CmnFuncTable: array [0..1] of AnsiString =
+  CmnFuncTable: array [0..0] of AnsiString =
   (
-    'function MsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons: Integer): Integer;',
     'function MinimizePathName(const Filename: String; const Font: TFont; MaxLen: Integer): String;'
   );
 
@@ -181,7 +180,7 @@ const
   );
 
   { Main }
-  MainTable: array [0..23] of AnsiString =
+  MainTable: array [0..26] of AnsiString =
   (
     'function WizardForm: TWizardForm;',
     'function MainForm: TMainForm;',
@@ -196,7 +195,10 @@ const
     'function GetWindowsVersion: Cardinal;',
     'procedure GetWindowsVersionEx(var Version: TWindowsVersion);',
     'function GetWindowsVersionString: String;',
+    'function MsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons: Integer): Integer;',
     'function SuppressibleMsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons, Default: Integer): Integer;',
+    'function TaskDialogMsgBox(const Instruction, TaskDialogText, MsgBoxText: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: TArrayOfString; const ShieldButton: Integer; const ForceMsgBox: Boolean): Integer;',
+    'function SuppressibleTaskDialogMsgBox(const Instruction, TaskDialogText, MsgBoxText: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: TArrayOfString; const ShieldButton: Integer; const ForceMsgBox: Boolean;'+'const Default: Integer): Integer;',
     'function IsWin64: Boolean;',
     'function Is64BitInstallMode: Boolean;',
     'function ProcessorArchitecture: TSetupProcessorArchitecture;',

+ 42 - 39
Projects/ScriptFunc_R.pas

@@ -101,6 +101,17 @@ begin
     InternalError('An attempt was made to access UninstallProgressForm before it has been created'); 
 end;
 
+function GetMsgBoxCaption: String;
+var
+  ID: TSetupMessageID;
+begin
+  if IsUninstaller then
+    ID := msgUninstallAppTitle
+  else
+    ID := msgSetupAppTitle;
+  Result := SetupMessages[ID];
+end;
+
 procedure InitializeScaleBaseUnits;
 var
   Font: TFont;
@@ -122,28 +133,6 @@ end;
 
 { ScriptDlg }
 function ScriptDlgProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
-
-  function ArrayToStringList(Arr: PPSVariantIFC): TStringList;
-  var
-    StringList: TStringList;
-    I, N: Integer;
-  begin
-    StringList := TStringList.Create();
-    N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
-    for I := 0 to N-1 do
-      StringList.Append(VNGetString(PSGetArrayField(Arr^, I)));
-    Result := StringList;
-  end;
-
-  procedure StringListToArray(StringList: TStringList; Arr: PPSVariantIFC);
-  var
-    I, N: Integer;
-  begin
-    N := StringList.Count;
-    for I := 0 to N-1 do
-      VNSetString(PSGetArrayField(Arr^, I), StringList[I]);
-  end;
-
 var
   PStart: Cardinal;
   NewPage: TWizardPage;
@@ -367,18 +356,11 @@ end;
 function CmnFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 var
   PStart: Cardinal;
-  ID: TSetupMessageID;
 begin
   PStart := Stack.Count-1;
   Result := True;
 
-  if Proc.Name = 'MSGBOX' then begin
-    if IsUninstaller then
-      ID := msgUninstallAppTitle
-    else
-      ID := msgSetupAppTitle;
-    Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), SetupMessages[ID], TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), False, 0));
-  end else if Proc.Name = 'MINIMIZEPATHNAME' then begin
+  if Proc.Name = 'MINIMIZEPATHNAME' then begin
     Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3)));
   end else
     Result := False;
@@ -593,12 +575,12 @@ begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
-      Stack.GetString(PStart-2), @Arr, True));
+    Stack.GetString(PStart-2), @Arr, True));
   end else if Proc.Name = 'REGGETVALUENAMES' then begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
-      Stack.GetString(PStart-2), @Arr, False));
+    Stack.GetString(PStart-2), @Arr, False));
   end else if Proc.Name = 'REGQUERYSTRINGVALUE' then begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     S := Stack.GetString(PStart-2);
@@ -982,8 +964,12 @@ var
   PStart: Cardinal;
   MinVersion, OnlyBelowVersion: TSetupVersionData;
   WizardComponents, WizardTasks: TStringList;
-  ID: TSetupMessageID;
   S: String;
+  Suppressible: Boolean;
+  Default: Integer;
+  Arr: TPSVariantIFC;
+  N, I: Integer;
+  ButtonLabels: array of String;
 begin
   PStart := Stack.Count-1;
   Result := True;
@@ -1038,12 +1024,29 @@ begin
   end else if Proc.Name = 'GETWINDOWSVERSIONSTRING' then begin
     Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
       (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF]));
-  end else if Proc.Name = 'SUPPRESSIBLEMSGBOX' then begin
-    if IsUninstaller then
-      ID := msgUninstallAppTitle
-    else
-      ID := msgSetupAppTitle;
-    Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), SetupMessages[ID], TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), True, Stack.GetInt(PStart-4)));
+  end else if (Proc.Name = 'MSGBOX') or (Proc.Name = 'SUPPRESSIBLEMSGBOX') then begin
+    if Proc.Name = 'MSGBOX' then begin
+      Suppressible := False;
+      Default := 0;
+    end else begin
+      Suppressible := True;
+      Default := Stack.GetInt(PStart-4);
+    end;
+    Stack.SetInt(PStart, LoggedMsgBox(Stack.GetString(PStart-1), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3), Suppressible, Default));
+  end else if (Proc.Name = 'TASKDIALOGMSGBOX') or (Proc.Name = 'SUPPRESSIBLETASKDIALOGMSGBOX') then begin
+    if Proc.Name = 'TASKDIALOGMSGBOX' then begin
+      Suppressible := False;
+      Default := 0;
+    end else begin
+      Suppressible := True;
+      Default := Stack.GetInt(PStart-9);
+    end;
+    Arr := NewTPSVariantIFC(Stack[PStart-6], True);
+    N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
+    SetLength(ButtonLabels, N);
+    for I := 0 to N-1 do
+      ButtonLabels[I] := VNGetString(PSGetArrayField(Arr, I));
+    Stack.SetInt(PStart, LoggedTaskDialogMsgBox('', Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), GetMsgBoxCaption, TMsgBoxType(Stack.GetInt(PStart-4)), Stack.GetInt(PStart-5), ButtonLabels, Stack.GetInt(PStart-7), Stack.GetBool(PStart-8), Suppressible, Default));
   end else if Proc.Name = 'ISWIN64' then begin
     Stack.SetBool(PStart, IsWin64);
   end else if Proc.Name = 'IS64BITINSTALLMODE' then begin

+ 2 - 1
Projects/Setup.dpr

@@ -68,7 +68,8 @@ uses
   ResUpdate in 'ResUpdate.pas',
   SpawnCommon in 'SpawnCommon.pas',
   SpawnServer in 'SpawnServer.pas',
-  SpawnClient in 'SpawnClient.pas';
+  SpawnClient in 'SpawnClient.pas',
+  TaskDialog in 'TaskDialog.pas';
 
 {$R *.RES}
 {$IFDEF UNICODE}

+ 2 - 2
Projects/Struct.pas

@@ -65,7 +65,7 @@ type
     {$IFNDEF UNICODE}shShowUndisplayableLanguages, {$ENDIF}shSetupLogging,
     shSignedUninstaller, shUsePreviousLanguage, shDisableWelcomePage,
     shCloseApplications, shRestartApplications, shAllowNetworkDrive,
-    shForceCloseApplications);
+    shForceCloseApplications, shAppNameHasConsts);
   TSetupLanguageDetectionMethod = (ldUILanguage, ldLocale, ldNone);
   TSetupCompressMethod = (cmStored, cmZip, cmBzip, cmLZMA, cmLZMA2);
   TSetupSalt = array[0..7] of Byte;
@@ -73,7 +73,7 @@ type
   TSetupProcessorArchitectures = set of TSetupProcessorArchitecture;
   TSetupDisablePage = (dpAuto, dpNo, dpYes);
   TSetupPrivilegesRequired = (prNone, prPowerUser, prAdmin, prLowest);
-  TSetupPrivilegesRequiredOverride = (proCommandLine, proMsgBox);
+  TSetupPrivilegesRequiredOverride = (proCommandLine, proDialog);
   TSetupPrivilegesRequiredOverrides = set of TSetupPrivilegesRequiredOverride;
 const
   SetupProcessorArchitectureNames: array[TSetupProcessorArchitecture] of String =

+ 178 - 0
Projects/TaskDialog.pas

@@ -0,0 +1,178 @@
+unit TaskDialog;
+
+{
+  Inno Setup
+  Copyright (C) 1997-2018 Jordan Russell
+  Portions by Martijn Laan
+  For conditions of distribution and use, see LICENSE.TXT.
+
+  TaskDialogMsgBox function integrating with CmnFunc's MsgBox functions
+}
+
+interface
+
+uses
+  CmnFunc;
+
+function TaskDialogMsgBox(const Icon, Instruction, TaskDialogText, MsgBoxText, Caption: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String; const ShieldButton: Integer; const ForceMsgBox: Boolean): Integer;
+
+implementation
+
+uses
+  Windows, Classes, StrUtils, Math, Forms, Dialogs, SysUtils, Commctrl, CmnFunc2, InstFunc, PathFunc;
+
+var
+  TaskDialogIndirectFunc: function(const pTaskConfig: TTaskDialogConfig;
+    pnButton: PInteger; pnRadioButton: PInteger;
+    pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;
+
+function ShieldButtonCallback(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; lpRefData: LONG_PTR): HResult; stdcall;
+begin
+  if (msg = TDN_CREATED) and (lpRefData <> 0) then
+    SendMessage(hwnd, TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE, lpRefData, 1);
+  Result := S_OK;
+end;
+
+
+function DoTaskDialog(const hWnd: HWND; const Instruction, Text, Caption, Icon: PWideChar; const CommonButtons: Cardinal; const ButtonLabels: array of String; const ButtonIDs: array of Integer; const ShieldButton: Integer; const RightToLeft: Boolean; const TriggerMessageBoxCallbackFuncFlags: LongInt; var ModalResult: Integer): Boolean;
+var
+  Config: TTaskDialogConfig;
+  NButtonLabelsAvailable: Integer;
+  ButtonItems: TTaskDialogButtons;
+  ButtonItem: TTaskDialogButtonItem;
+  I: Integer;
+  ActiveWindow: Windows.HWND;
+  WindowList: Pointer;
+begin
+  if Assigned(TaskDialogIndirectFunc) then begin
+    try
+      ZeroMemory(@Config, Sizeof(Config));
+      Config.cbSize := SizeOf(Config);
+      if RightToLeft then
+        Config.dwFlags := Config.dwFlags or TDF_RTL_LAYOUT;
+      { If the application window isn't currently visible, show the task dialog
+        with no owner window so it'll get a taskbar button } 
+      Config.hInstance := HInstance;
+      if IsIconic(Application.Handle) or
+         (GetWindowLong(Application.Handle, GWL_STYLE) and WS_VISIBLE = 0) or
+         (GetWindowLong(Application.Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW <> 0) then
+        Config.hWndParent := 0
+      else
+        Config.hwndParent := hWnd;
+      Config.dwCommonButtons := CommonButtons;
+      Config.pszWindowTitle := Caption;
+      Config.pszMainIcon := Icon;
+      Config.pszMainInstruction := Instruction;
+      Config.pszContent := Text;
+      if ShieldButton <> 0 then begin
+        Config.pfCallback := ShieldButtonCallback;
+        Config.lpCallbackData := ShieldButton;
+      end;
+      ButtonItems := nil;
+      try
+        NButtonLabelsAvailable := Length(ButtonLabels);
+        if NButtonLabelsAvailable <> 0 then begin
+          ButtonItems := TTaskDialogButtons.Create(nil, TTaskDialogButtonItem);
+          Config.dwFlags := Config.dwFlags or TDF_USE_COMMAND_LINKS;
+          for I := 0 to NButtonLabelsAvailable-1 do begin
+            ButtonItem := TTaskDialogButtonItem(ButtonItems.Add);
+            ButtonItem.Caption := ButtonLabels[I];
+            ButtonItem.ModalResult := ButtonIDs[I];
+          end;
+          Config.pButtons := ButtonItems.Buttons;
+          Config.cButtons := ButtonItems.Count;
+        end;
+        TriggerMessageBoxCallbackFunc(TriggerMessageBoxCallbackFuncFlags, False);
+        ActiveWindow := GetActiveWindow;
+        WindowList := DisableTaskWindows(0);
+        try
+          Result := TaskDialogIndirectFunc(Config, @ModalResult, nil, nil) = S_OK;
+        finally
+          EnableTaskWindows(WindowList);
+          SetActiveWindow(ActiveWindow);
+          TriggerMessageBoxCallbackFunc(TriggerMessageBoxCallbackFuncFlags, True);
+        end;
+      finally
+        ButtonItems.Free;
+      end;
+    except
+      Result := False;
+    end;
+  end else
+    Result := False;
+end;
+
+function TaskDialogMsgBox(const Icon, Instruction, TaskDialogText, MsgBoxText, Caption: String; const Typ: TMsgBoxType; const Buttons: Cardinal; const ButtonLabels: array of String; const ShieldButton: Integer; const ForceMsgBox: Boolean): Integer;
+var
+  IconP: PChar;
+  TDCommonButtons: Cardinal;
+  NButtonLabelsAvailable: Integer;
+  ButtonIDs: array of Integer;
+begin
+  if Icon <> '' then
+    IconP := PChar(Icon)
+  else begin
+    case Typ of
+      mbInformation: IconP := TD_INFORMATION_ICON;
+      mbError: IconP := TD_WARNING_ICON;
+      mbCriticalError: IconP := TD_ERROR_ICON;
+    else
+      IconP := nil; { No other TD_ constant available, MS recommends to use no icon for questions now and the old icon should only be used for help entries }
+    end;
+  end;
+  NButtonLabelsAvailable := Length(ButtonLabels);
+  case Buttons of
+    MB_OK, MB_OKCANCEL:
+      begin
+        if NButtonLabelsAvailable = 0 then
+          TDCommonButtons := TDCBF_OK_BUTTON
+        else begin
+          TDCommonButtons := 0;
+          ButtonIDs := [IDOK];
+        end;
+        if Buttons = MB_OKCANCEL then
+          TDCommonButtons := TDCommonButtons or TDCBF_CANCEL_BUTTON;
+      end;
+    MB_YESNO, MB_YESNOCANCEL:
+      begin
+        if NButtonLabelsAvailable = 0 then
+          TDCommonButtons := TDCBF_YES_BUTTON or TDCBF_NO_BUTTON
+        else begin
+          TDCommonButtons := 0;
+          ButtonIDs := [IDYES, IDNO];
+        end;
+        if Buttons = MB_YESNOCANCEL then
+          TDCommonButtons := TDCommonButtons or TDCBF_CANCEL_BUTTON;
+      end;
+    MB_RETRYCANCEL:
+      begin
+        if NButtonLabelsAvailable = 0 then
+          TDCommonButtons := TDCBF_RETRY_BUTTON
+        else begin
+          TDCommonButtons := 0;
+          ButtonIDs := [IDRETRY];
+        end;
+        TDCommonButtons := TDCommonButtons or TDCBF_CANCEL_BUTTON;
+      end;
+    else
+      begin
+        InternalError('TaskDialogMsgBox: Invalid Buttons');
+        TDCommonButtons := 0; { Silence compiler }
+      end;
+  end;
+  if Length(ButtonIDs) <> NButtonLabelsAvailable then
+    InternalError('TaskDialogMsgBox: Invalid ButtonLabels');
+  if ForceMsgBox or
+     not DoTaskDialog(Application.Handle, PChar(Instruction), PChar(TaskDialogText),
+           GetMessageBoxCaption(PChar(Caption), Typ), IconP, TDCommonButtons, ButtonLabels, ButtonIDs, ShieldButton,
+           GetMessageBoxRightToLeft, IfThen(Typ = mbCriticalError, MB_ICONSTOP, 0), Result) then
+    Result := MsgBox(MsgBoxText, IfThen(Instruction <> '', Instruction, Caption), Typ, Buttons);
+end;
+
+procedure InitCommonControls; external comctl32 name 'InitCommonControls';
+
+initialization
+  InitCommonControls;
+  TaskDialogIndirectFunc := GetProcAddress(GetModuleHandle(comctl32), 'TaskDialogIndirect');
+
+end.

+ 6 - 5
whatsnew.htm

@@ -50,13 +50,13 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
   <li>The Compiler IDE's New Script Wizard now offers an option to select administrative or non administrative install mode and outputs scripts which work in both modes.</li>
   <li>Pascal Scripting changes: Added new <tt>IsAdminInstallMode</tt> support function.</li>
 </ul>
-<p><span class="head2">Dynamic install mode</span></p>
+<p><span class="head2">Overridable install mode</span></p>
 <p>Once your script is fully updated to support both administrative and non administrative mode (for example by using the new &quot;auto&quot; constants and the new [Registry] section <tt>Root</tt> value <tt>HKA</tt>) you can then use the following:</p>
 <ul>
-  <li>Added new [Setup] section directive: <tt>PrivilegesRequiredOverridesAllowed</tt>, which can be set to one or more overrides which allow the end user to override the script's default <tt>PrivilegesRequired</tt> setting. The following overrides are supported: <tt>commandline</tt> and <tt>msgbox</tt>.</li>
+  <li>Added new [Setup] section directive: <tt>PrivilegesRequiredOverridesAllowed</tt>, which can be set to one or more overrides which allow the end user to override the script's default <tt>PrivilegesRequired</tt> setting. The following overrides are supported: <tt>commandline</tt> and <tt>dialog</tt>.</li>
   <ul>
     <li>If override <tt>commandline</tt> is allowed then Setup will support two additional command line parameters to override the script's default <tt>PrivilegesRequired</tt> setting: /ALLUSERS and /CURRENTUSER.</li>
-    <li>If override <tt>msgbox</tt> is allowed then Setup will ask the user whether administrative or non administrative install mode should be used based on the script's default <tt>PrivilegesRequired</tt> setting. Allowing <tt>msgbox</tt> automatically allows <tt>commandline</tt> and when one of the command line parameters is used then Setup will not ask the user.</li>
+    <li>If override <tt>dialog</tt> is allowed then Setup will ask the user to choose the install mode based on the script's default <tt>PrivilegesRequired</tt> setting using a suppressible dialog (<a href="https://i.imgur.com/9tjXjmg.png">example</a> if <tt>PrivilegesRequired</tt> is set to <tt>admin</tt>). Allowing <tt>dialog</tt> automatically allows <tt>commandline</tt> and when one of the command line parameters is used then Setup will not ask the user.</li>
   </ul>
   <li>Inno Setup's own installer now supports both administrative and non administrative mode and allows the <tt>commandline</tt> override.</li>
 </ul>
@@ -85,6 +85,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <li>Pascal Scripting changes:
 <ul>
   <li>Using event attributes it is now possible to have multiple implementations of the same event function in your script. This is especially useful in included scripts implementing an event function to avoid conflicts with the main script. See the help file for more information and the <i>CodeExample1.iss</i> example script for an example.</li>
+  <li>Added new <tt>TaskDialogMsgBox</tt> and <tt>SuppressibleTaskDialogMsgBox</tt> support functions which display a task dialog if supported by the system and a regular message box otherwise (<a href="https://i.imgur.com/hU4RQP2.png">example</a>). See the help file for more information and the <i>CodeClasses.iss</i> example script for an example.</li>
   <li>[Setup] section directives <tt>ChangesAssociations</tt> and <tt>ChangesEnvironment</tt> may now be set to a boolean expression, which may contain calls to check functions.</li>
   <li>Added new special-purpose <i>HelpTextNote</i> message that can be used to specify one or more lines of text that are added to the list of parameters in the summary shown when passing /HELP on the command line. This message defaults to an empty string so make sure to provide a non-empty default for all languages from your main script if you want to use it.</li>
   <li>Added new <tt>SameStr</tt> and <tt>SameText</tt> support functions.</li>
@@ -108,9 +109,9 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 
 <p>Contributions via <a href="https://github.com/jrsoftware/issrc" target="_blank">GitHub</a>: Thanks to jogo-, Martin Prikryl, dscharrer, Kleuter, Gavin Lambert, Stef&aacute;n &Ouml;rvar Sigmundsson, DRON, and Kevin Puetz for their contributions.</p>
 
-<p>Some messages have been added in this version: (<a href="https://github.com/jrsoftware/issrc/commit/b0cd1a0177b818e36734026c67dc24f01ad6a0d0">View differences in Default.isl</a>).</p>
+<p>Some messages have been added in this version:<!-- (<a href="https://github.com/jrsoftware/issrc/commit/b0cd1a0177b818e36734026c67dc24f01ad6a0d0">View differences in Default.isl</a>).--></p>
 <ul>
-  <li><b>New messages:</b> PrivilegesRequiredOverrideMsgBox1, PrivilegesRequiredOverrideMsgBox2, UninstallDisplayNameMark, UninstallDisplayNameMarks, UninstallDisplayNameMark32Bit, UninstallDisplayNameMark64Bit, UninstallDisplayNameMarkAllUsers, UninstallDisplayNameCurrentUser.</li>
+  <li><b>New messages:</b> PrivilegesRequiredOverrideInstruction, PrivilegesRequiredOverrideThisProgram, PrivilegesRequiredOverrideTaskDialogText1, PrivilegesRequiredOverrideMsgBoxText1, PrivilegesRequiredOverrideTaskDialogText2, PrivilegesRequiredOverrideMsgBoxText2, PrivilegesRequiredOverrideAllUsers, PrivilegesRequiredOverrideCurrentUser, PrivilegesRequiredOverrideRecommended, UninstallDisplayNameMark, UninstallDisplayNameMarks, UninstallDisplayNameMark32Bit, UninstallDisplayNameMark64Bit, UninstallDisplayNameMarkAllUsers, UninstallDisplayNameCurrentUser.</li>
 </ul>
 
 <p>Note: Only the official English and Dutch (Netherlands) translations have been updated for these changes at this moment. See the <a href="http://www.jrsoftware.org/files/istrans/">Inno Setup Translations</a> page for more information.</p>