Selaa lähdekoodia

Merge branch 'taskdialog' into compiler-update

Martijn Laan 6 vuotta sitten
vanhempi
commit
32347a74f1

+ 23 - 1
Examples/CodeClasses.iss

@@ -77,10 +77,23 @@ begin
   end;
   end;
 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;
 procedure CreateTheWizardPages;
 var
 var
   Page: TWizardPage;
   Page: TWizardPage;
-  Button, FormButton: TNewButton;
+  Button, FormButton, TaskDialogButton: TNewButton;
   Panel: TPanel;
   Panel: TPanel;
   CheckBox: TNewCheckBox;
   CheckBox: TNewCheckBox;
   Edit: TNewEdit;
   Edit: TNewEdit;
@@ -153,6 +166,15 @@ begin
   FormButton.OnClick := @FormButtonOnClick;
   FormButton.OnClick := @FormButtonOnClick;
   FormButton.Parent := Page.Surface;
   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 }
   { TComboBox and others }
 
 
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', '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.
 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
 ; *** 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
 ; *** Misc. errors
 ErrorCreatingDir=Setup was unable to create the directory "%1"
 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.
 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
 ; *** 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
 ; *** Misc. errors
 ErrorCreatingDir=Setup kan de map "%1" niet maken
 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 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>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 (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>
 </ul>
 </dd>
 </dd>
 
 
@@ -3958,13 +3958,13 @@ Name: portablemode; Description: "Portable Mode"</pre></example>
 
 
 <setuptopic directive="PrivilegesRequiredOverridesAllowed">
 <setuptopic directive="PrivilegesRequiredOverridesAllowed">
 <keyword value="commandline" />
 <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>
 <setupdefault><i>(blank)</i></setupdefault>
 <body>
 <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>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>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>
 </body>
 </setuptopic>
 </setuptopic>
 
 

+ 49 - 2
ISHelp/isxfunc.xml

@@ -2329,9 +2329,13 @@ end;</pre></example>
       <function>
       <function>
         <name>MsgBox</name>
         <name>MsgBox</name>
         <prototype>function MsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons: Integer): Integer;</prototype>
         <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>
         <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
         <example><pre>begin
   // Display a simple message box with an OK button
   // Display a simple message box with an OK button
   MsgBox('Hello.', mbInformation, MB_OK);
   MsgBox('Hello.', mbInformation, MB_OK);
@@ -2348,12 +2352,55 @@ end;</pre></example>
     // user clicked Yes
     // user clicked Yes
   end;
   end;
 end;</pre></example>
 end;</pre></example>
+        <seealso><p><link topic="isxfunc_SuppressibleMsgBox">SuppressibleMsgBox</link><br />
+<link topic="isxfunc_TaskDialogMsgBox">TaskDialogMsgBox</link></p></seealso>
       </function>
       </function>
       <function>
       <function>
         <name>SuppressibleMsgBox</name>
         <name>SuppressibleMsgBox</name>
         <prototype>function SuppressibleMsgBox(const Text: String; const Typ: TMsgBoxType; const Buttons, Default: Integer): Integer;</prototype>
         <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>
         <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>
+      <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>
       <function>
         <name>GetOpenFileName</name>
         <name>GetOpenFileName</name>
         <prototype>function GetOpenFileName(const Prompt: String; var FileName: String; const InitialDirectory, Filter, DefaultExtension: String): Boolean;</prototype>
         <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;
   const Caption: String; const Typ: TMsgBoxType; const Buttons: Cardinal): Integer;
 procedure ReactivateTopWindow;
 procedure ReactivateTopWindow;
 procedure SetMessageBoxCaption(const Typ: TMsgBoxType; const NewCaption: PChar);
 procedure SetMessageBoxCaption(const Typ: TMsgBoxType; const NewCaption: PChar);
+function GetMessageBoxCaption(const Caption: PChar; const Typ: TMsgBoxType): PChar;
 procedure SetMessageBoxRightToLeft(const ARightToLeft: Boolean);
 procedure SetMessageBoxRightToLeft(const ARightToLeft: Boolean);
+function GetMessageBoxRightToLeft: Boolean;
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
+procedure TriggerMessageBoxCallbackFunc(const Flags: LongInt; const After: Boolean);
 
 
 implementation
 implementation
 
 
@@ -165,11 +168,42 @@ begin
     MessageBoxCaptions[Typ] := StrNew(NewCaption);
     MessageBoxCaptions[Typ] := StrNew(NewCaption);
 end;
 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);
 procedure SetMessageBoxRightToLeft(const ARightToLeft: Boolean);
 begin
 begin
   MessageBoxRightToLeft := ARightToLeft;
   MessageBoxRightToLeft := ARightToLeft;
 end;
 end;
 
 
+function GetMessageBoxRightToLeft: Boolean;
+begin
+  Result := MessageBoxRightToLeft;
+end;
+
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
 procedure SetMessageBoxCallbackFunc(const AFunc: TMsgBoxCallbackFunc; const AParam: LongInt);
 begin
 begin
   MessageBoxCallbackFunc := AFunc;
   MessageBoxCallbackFunc := AFunc;
@@ -248,26 +282,26 @@ begin
   if MessageBoxRightToLeft then
   if MessageBoxRightToLeft then
     Flags := Flags or (MB_RTLREADING or MB_RIGHT);
     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);
   TriggerMessageBoxCallbackFunc(Flags, False);
   try
   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}
 {$IFDEF IS_D4}
     { On Delphi 4+, simply call Application.MessageBox }
     { On Delphi 4+, simply call Application.MessageBox }
     Result := Application.MessageBox(Text, Caption, Flags);
     Result := Application.MessageBox(Text, Caption, Flags);
@@ -303,30 +337,8 @@ function MsgBoxP(const Text, Caption: PChar; const Typ: TMsgBoxType;
 const
 const
   IconFlags: array[TMsgBoxType] of Cardinal =
   IconFlags: array[TMsgBoxType] of Cardinal =
     (MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONEXCLAMATION, MB_ICONSTOP);
     (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
 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;
 end;
 
 
 function MsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
 function MsgBox(const Text, Caption: String; const Typ: TMsgBoxType;

+ 9 - 6
Projects/Compile.pas

@@ -3705,7 +3705,7 @@ var
 
 
   function StrToPrivilegesRequiredOverrides(S: String): TSetupPrivilegesRequiredOverrides;
   function StrToPrivilegesRequiredOverrides(S: String): TSetupPrivilegesRequiredOverrides;
   const
   const
-    Overrides: array[0..1] of PChar = ('commandline', 'msgbox');
+    Overrides: array[0..1] of PChar = ('commandline', 'dialog');
   begin
   begin
     Result := [];
     Result := [];
     while True do
     while True do
@@ -3713,7 +3713,7 @@ var
         -2: Break;
         -2: Break;
         -1: Invalid;
         -1: Invalid;
         0: Include(Result, proCommandLine);
         0: Include(Result, proCommandLine);
-        1: Result := Result + [proCommandLine, proMsgBox];
+        1: Result := Result + [proCommandLine, proDialog];
       end;
       end;
   end;
   end;
 var
 var
@@ -8632,10 +8632,13 @@ begin
       AbortCompile(SCompilerAppVersionOrAppVerNameRequired);
       AbortCompile(SCompilerAppVersionOrAppVerNameRequired);
     LineNumber := SetupDirectiveLines[ssAppName];
     LineNumber := SetupDirectiveLines[ssAppName];
     AppNameHasConsts := CheckConst(SetupHeader.AppName, SetupHeader.MinVersion, []);
     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;
     end;
     if SetupHeader.AppId = '' then
     if SetupHeader.AppId = '' then
       SetupHeader.AppId := SetupHeader.AppName
       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;
   const Suppressible: Boolean; const Default: Integer): Integer;
 function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
 function LoggedMsgBox(const Text, Caption: String; const Typ: TMsgBoxType;
   const Buttons: Cardinal; const Suppressible: Boolean; const Default: Integer): Integer;
   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 LogWindowsVersion;
 procedure NotifyAfterInstallEntry(const AfterInstall: String);
 procedure NotifyAfterInstallEntry(const AfterInstall: String);
 procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
 procedure NotifyAfterInstallFileEntry(const FileEntry: PSetupFileEntry);
@@ -255,7 +258,8 @@ uses
   Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
   Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
   Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
   Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
   {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
   {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
-  SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion, BitmapImage;
+  SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion, BitmapImage,
+  TaskDialog;
 
 
 {$R *.DFM}
 {$R *.DFM}
 
 
@@ -2373,6 +2377,24 @@ begin
   end;
   end;
 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;
 procedure RestartComputerFromThisProcess;
 begin
 begin
   RestartInitiatedByThisProcess := True;
   RestartInitiatedByThisProcess := True;
@@ -2769,7 +2791,7 @@ var
   LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
   LastShownComponentEntry, ComponentEntry: PSetupComponentEntry;
   MinimumTypeSpace: Integer64;
   MinimumTypeSpace: Integer64;
   SourceWildcard: String;
   SourceWildcard: String;
-  ExpandedSetupMutex, ExtraRespawnParam, RespawnParams: String;
+  ExpandedSetupMutex, AppName, ExtraRespawnParam, RespawnParams: String;
 begin
 begin
   InitializeCommonVars;
   InitializeCommonVars;
 
 
@@ -2967,24 +2989,46 @@ begin
         { Apply InitPrivilegesRequired }
         { Apply InitPrivilegesRequired }
         if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then
         if HasInitPrivilegesRequired and (proCommandLine in SetupHeader.PrivilegesRequiredOverridesAllowed) then
           SetupHeader.PrivilegesRequired := InitPrivilegesRequired
           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.
           { 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 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
           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;
         end;
         end;
 
 

+ 9 - 2
Projects/MsgIDs.pas

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

+ 5 - 3
Projects/ScriptFunc.pas

@@ -47,9 +47,8 @@ const
   );
   );
 
 
   { CmnFunc }
   { 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;'
     'function MinimizePathName(const Filename: String; const Font: TFont; MaxLen: Integer): String;'
   );
   );
 
 
@@ -181,7 +180,7 @@ const
   );
   );
 
 
   { Main }
   { Main }
-  MainTable: array [0..23] of AnsiString =
+  MainTable: array [0..26] of AnsiString =
   (
   (
     'function WizardForm: TWizardForm;',
     'function WizardForm: TWizardForm;',
     'function MainForm: TMainForm;',
     'function MainForm: TMainForm;',
@@ -196,7 +195,10 @@ const
     'function GetWindowsVersion: Cardinal;',
     'function GetWindowsVersion: Cardinal;',
     'procedure GetWindowsVersionEx(var Version: TWindowsVersion);',
     'procedure GetWindowsVersionEx(var Version: TWindowsVersion);',
     'function GetWindowsVersionString: String;',
     '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 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 IsWin64: Boolean;',
     'function Is64BitInstallMode: Boolean;',
     'function Is64BitInstallMode: Boolean;',
     'function ProcessorArchitecture: TSetupProcessorArchitecture;',
     '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'); 
     InternalError('An attempt was made to access UninstallProgressForm before it has been created'); 
 end;
 end;
 
 
+function GetMsgBoxCaption: String;
+var
+  ID: TSetupMessageID;
+begin
+  if IsUninstaller then
+    ID := msgUninstallAppTitle
+  else
+    ID := msgSetupAppTitle;
+  Result := SetupMessages[ID];
+end;
+
 procedure InitializeScaleBaseUnits;
 procedure InitializeScaleBaseUnits;
 var
 var
   Font: TFont;
   Font: TFont;
@@ -122,28 +133,6 @@ end;
 
 
 { ScriptDlg }
 { ScriptDlg }
 function ScriptDlgProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 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
 var
   PStart: Cardinal;
   PStart: Cardinal;
   NewPage: TWizardPage;
   NewPage: TWizardPage;
@@ -367,18 +356,11 @@ end;
 function CmnFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 function CmnFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 var
 var
   PStart: Cardinal;
   PStart: Cardinal;
-  ID: TSetupMessageID;
 begin
 begin
   PStart := Stack.Count-1;
   PStart := Stack.Count-1;
   Result := True;
   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)));
     Stack.SetString(PStart, MinimizePathName(Stack.GetString(PStart-1), TFont(Stack.GetClass(PStart-2)), Stack.GetInt(PStart-3)));
   end else
   end else
     Result := False;
     Result := False;
@@ -593,12 +575,12 @@ begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
     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
   end else if Proc.Name = 'REGGETVALUENAMES' then begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Arr := NewTPSVariantIFC(Stack[PStart-3], True);
     Stack.SetBool(PStart, GetSubkeyOrValueNames(RegView, RootKey,
     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
   end else if Proc.Name = 'REGQUERYSTRINGVALUE' then begin
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     CrackCodeRootKey(Stack.GetInt(PStart-1), RegView, RootKey);
     S := Stack.GetString(PStart-2);
     S := Stack.GetString(PStart-2);
@@ -982,8 +964,12 @@ var
   PStart: Cardinal;
   PStart: Cardinal;
   MinVersion, OnlyBelowVersion: TSetupVersionData;
   MinVersion, OnlyBelowVersion: TSetupVersionData;
   WizardComponents, WizardTasks: TStringList;
   WizardComponents, WizardTasks: TStringList;
-  ID: TSetupMessageID;
   S: String;
   S: String;
+  Suppressible: Boolean;
+  Default: Integer;
+  Arr: TPSVariantIFC;
+  N, I: Integer;
+  ButtonLabels: array of String;
 begin
 begin
   PStart := Stack.Count-1;
   PStart := Stack.Count-1;
   Result := True;
   Result := True;
@@ -1038,12 +1024,29 @@ begin
   end else if Proc.Name = 'GETWINDOWSVERSIONSTRING' then begin
   end else if Proc.Name = 'GETWINDOWSVERSIONSTRING' then begin
     Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
     Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
       (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF]));
       (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
   end else if Proc.Name = 'ISWIN64' then begin
     Stack.SetBool(PStart, IsWin64);
     Stack.SetBool(PStart, IsWin64);
   end else if Proc.Name = 'IS64BITINSTALLMODE' then begin
   end else if Proc.Name = 'IS64BITINSTALLMODE' then begin

+ 2 - 1
Projects/Setup.dpr

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

+ 2 - 2
Projects/Struct.pas

@@ -65,7 +65,7 @@ type
     {$IFNDEF UNICODE}shShowUndisplayableLanguages, {$ENDIF}shSetupLogging,
     {$IFNDEF UNICODE}shShowUndisplayableLanguages, {$ENDIF}shSetupLogging,
     shSignedUninstaller, shUsePreviousLanguage, shDisableWelcomePage,
     shSignedUninstaller, shUsePreviousLanguage, shDisableWelcomePage,
     shCloseApplications, shRestartApplications, shAllowNetworkDrive,
     shCloseApplications, shRestartApplications, shAllowNetworkDrive,
-    shForceCloseApplications);
+    shForceCloseApplications, shAppNameHasConsts);
   TSetupLanguageDetectionMethod = (ldUILanguage, ldLocale, ldNone);
   TSetupLanguageDetectionMethod = (ldUILanguage, ldLocale, ldNone);
   TSetupCompressMethod = (cmStored, cmZip, cmBzip, cmLZMA, cmLZMA2);
   TSetupCompressMethod = (cmStored, cmZip, cmBzip, cmLZMA, cmLZMA2);
   TSetupSalt = array[0..7] of Byte;
   TSetupSalt = array[0..7] of Byte;
@@ -73,7 +73,7 @@ type
   TSetupProcessorArchitectures = set of TSetupProcessorArchitecture;
   TSetupProcessorArchitectures = set of TSetupProcessorArchitecture;
   TSetupDisablePage = (dpAuto, dpNo, dpYes);
   TSetupDisablePage = (dpAuto, dpNo, dpYes);
   TSetupPrivilegesRequired = (prNone, prPowerUser, prAdmin, prLowest);
   TSetupPrivilegesRequired = (prNone, prPowerUser, prAdmin, prLowest);
-  TSetupPrivilegesRequiredOverride = (proCommandLine, proMsgBox);
+  TSetupPrivilegesRequiredOverride = (proCommandLine, proDialog);
   TSetupPrivilegesRequiredOverrides = set of TSetupPrivilegesRequiredOverride;
   TSetupPrivilegesRequiredOverrides = set of TSetupPrivilegesRequiredOverride;
 const
 const
   SetupProcessorArchitectureNames: array[TSetupProcessorArchitecture] of String =
   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>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>
   <li>Pascal Scripting changes: Added new <tt>IsAdminInstallMode</tt> support function.</li>
 </ul>
 </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>
 <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>
 <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>
   <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>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>
   </ul>
   <li>Inno Setup's own installer now supports both administrative and non administrative mode and allows the <tt>commandline</tt> override.</li>
   <li>Inno Setup's own installer now supports both administrative and non administrative mode and allows the <tt>commandline</tt> override.</li>
 </ul>
 </ul>
@@ -85,6 +85,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <li>Pascal Scripting changes:
 <li>Pascal Scripting changes:
 <ul>
 <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>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>[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 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>
   <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>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>
 <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>
 </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>
 <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>