Browse Source

Add Uninstall support to WizardSetBackImage. Before it would reject to run, but there was no actual reason for this.

Moves SelectBestImage and TWizardForm.SetBackImage without changing them.
Martijn Laan 1 tuần trước cách đây
mục cha
commit
59634a8cff

+ 21 - 0
Projects/Src/Setup.MainFunc.pas

@@ -242,6 +242,7 @@ function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word =
 function IsWindows8: Boolean;
 function IsWindows8: Boolean;
 function IsWindows10: Boolean;
 function IsWindows10: Boolean;
 function IsWindows11: Boolean;
 function IsWindows11: Boolean;
+function SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
 
 
 implementation
 implementation
 
 
@@ -288,6 +289,26 @@ type
 
 
 { Misc. functions }
 { Misc. functions }
 
 
+function SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
+var
+  TargetArea, Difference, SmallestDifference, I: Integer;
+begin
+  if WizardImages.Count <> 1 then begin
+    { Find the image with the smallest area difference compared to the target area. }
+    TargetArea := TargetWidth*TargetHeight;
+    SmallestDifference := -1;
+    Result := nil;
+    for I := 0 to WizardImages.Count-1 do begin
+      Difference := Abs(TargetArea-WizardImages[I].Width*WizardImages[I].Height);
+      if (SmallestDifference = -1) or (Difference < SmallestDifference) then begin
+        Result := WizardImages[I];
+        SmallestDifference := Difference;
+      end;
+    end;
+  end else
+    Result := WizardImages[0];
+end;
+
 function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
 function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
 begin
 begin
   Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
   Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);

+ 7 - 2
Projects/Src/Setup.ScriptFunc.pas

@@ -1705,14 +1705,19 @@ var
         StringList.Free;
         StringList.Free;
       end;
       end;
     end);
     end);
-    RegisterScriptFunc('WizardSetBackImage', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
+    RegisterScriptFunc('WizardSetBackImage', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Integer)
     begin
     begin
       const WizardImages = TWizardImages.Create(False);
       const WizardImages = TWizardImages.Create(False);
       try
       try
         const BackImages = Stack.GetClassArray(PStart);
         const BackImages = Stack.GetClassArray(PStart);
         for var BackImage in BackImages do
         for var BackImage in BackImages do
           WizardImages.Add(TGraphic(BackImage));
           WizardImages.Add(TGraphic(BackImage));
-        GetWizardForm.SetBackImage(WizardImages, Stack.GetBool(PStart-1) , Stack.GetBool(PStart-2), Byte(Stack.GetInt(PStart-3)), True);
+        var Form: TSetupForm;
+        if IsUninstaller then
+          Form := GetUninstallProgressForm
+        else
+          Form := GetWizardForm;
+        Form.SetBackImage(WizardImages, Stack.GetBool(PStart-1) , Stack.GetBool(PStart-2), Byte(Stack.GetInt(PStart-3)), True);
       finally
       finally
         WizardImages.Free;
         WizardImages.Free;
       end;
       end;

+ 21 - 3
Projects/Src/Setup.SetupForm.pas

@@ -29,7 +29,8 @@ interface
 
 
 uses
 uses
   Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
   Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
-  UIStateForm;
+  UIStateForm,
+  Setup.MainFunc;
 
 
 type
 type
   TSetupForm = class(TUIStateForm)
   TSetupForm = class(TUIStateForm)
@@ -73,6 +74,7 @@ type
     class procedure SetCtlParent(const AControl: TControl; const AParent: TWinControl);
     class procedure SetCtlParent(const AControl: TControl; const AParent: TWinControl);
     function ScalePixelsX(const N: Integer): Integer; overload;
     function ScalePixelsX(const N: Integer): Integer; overload;
     function ScalePixelsY(const N: Integer): Integer; overload;
     function ScalePixelsY(const N: Integer): Integer; overload;
+    procedure SetBackImage(const BackImages: TWizardImages; const Stretch, Center: Boolean; const Opacity: Byte; const Redraw: Boolean); overload;
     function ShouldSizeX: Boolean;
     function ShouldSizeX: Boolean;
     function ShouldSizeY: Boolean;
     function ShouldSizeY: Boolean;
     function ShowModal: Integer; override;
     function ShowModal: Integer; override;
@@ -101,9 +103,9 @@ implementation
 
 
 uses
 uses
   Generics.Collections, UITypes, WinXPanels, Themes, StdCtrls, ExtCtrls,
   Generics.Collections, UITypes, WinXPanels, Themes, StdCtrls, ExtCtrls,
-  BidiUtils, BitmapButton, BitmapImage, NewNotebook, NewStaticText, NewCheckListBox,
+  BidiUtils, BitmapButton, BitmapImage, NewNotebook, NewStaticText, NewCheckListBox, FormBackgroundStyleHook,
   Shared.Struct, Shared.CommonFunc, Shared.CommonFunc.Vcl,
   Shared.Struct, Shared.CommonFunc, Shared.CommonFunc.Vcl,
-  Setup.MainFunc, Setup.InstFunc;
+  Setup.InstFunc;
 
 
 var
 var
   WM_QueryCancelAutoPlay: UINT;
   WM_QueryCancelAutoPlay: UINT;
@@ -737,6 +739,22 @@ begin
   Result := ScalePixelsY(FOrigBaseUnitY, FBaseUnitY, N);
   Result := ScalePixelsY(FOrigBaseUnitY, FBaseUnitY, N);
 end;
 end;
 
 
+procedure TSetupForm.SetBackImage(const BackImages: TWizardImages; const Stretch, Center: Boolean;
+  const Opacity: Byte; const Redraw: Boolean);
+begin
+  if not CustomWizardBackground then
+    InternalError('Cannot set a background image at this time: custom wizard background not active');
+  const Graphic = SelectBestImage(BackImages, ClientWidth, ClientHeight);
+  TFormBackgroundStyleHook.Graphic := Graphic;
+  TFormBackgroundStyleHook.GraphicTarget := Self;
+  TFormBackgroundStyleHook.Stretch := Stretch;
+  TFormBackgroundStyleHook.Center := Center;
+  TFormBackgroundStyleHook.Opacity := Opacity;
+  TNewCheckListBox.ComplexParentBackground := Graphic <> nil;
+  if Redraw and HandleAllocated then
+    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN);
+end;
+
 class procedure TSetupForm.SetCtlParent(const AControl: TControl; const AParent: TWinControl);
 class procedure TSetupForm.SetCtlParent(const AControl: TControl; const AParent: TWinControl);
 { To be called when a control is added after the form has already been created }
 { To be called when a control is added after the form has already been created }
 begin
 begin

+ 1 - 38
Projects/Src/Setup.WizardForm.pas

@@ -238,7 +238,6 @@ type
     procedure SetCurPage(const NewPageID: Integer);
     procedure SetCurPage(const NewPageID: Integer);
     procedure SelectComponents(const ASelectComponents: TStringList); overload;
     procedure SelectComponents(const ASelectComponents: TStringList); overload;
     procedure SelectTasks(const ASelectTasks: TStringList); overload;
     procedure SelectTasks(const ASelectTasks: TStringList); overload;
-    procedure SetBackImage(const BackImages: TWizardImages; const Stretch, Center: Boolean; const Opacity: Byte; const Redraw: Boolean); overload;
     procedure UpdateRunList(const SelectedComponents, SelectedTasks: TStringList);
     procedure UpdateRunList(const SelectedComponents, SelectedTasks: TStringList);
     function ValidateDirEdit: Boolean;
     function ValidateDirEdit: Boolean;
     function ValidateGroupEdit: Boolean;
     function ValidateGroupEdit: Boolean;
@@ -343,7 +342,7 @@ implementation
 
 
 uses
 uses
   ShellApi, ShlObj, Types, Generics.Collections, Themes,
   ShellApi, ShlObj, Types, Generics.Collections, Themes,
-  PathFunc, RestartManager, SHA256, FormBackgroundStyleHook,
+  PathFunc, RestartManager, SHA256,
   SetupLdrAndSetup.Messages, Setup.MainForm, Shared.CommonFunc.Vcl,
   SetupLdrAndSetup.Messages, Setup.MainForm, Shared.CommonFunc.Vcl,
   Shared.CommonFunc, Setup.InstFunc, Setup.SelectFolderForm, Setup.FileExtractor,
   Shared.CommonFunc, Setup.InstFunc, Setup.SelectFolderForm, Setup.FileExtractor,
   Setup.LoggingFunc, Setup.ScriptRunner, Shared.SetupTypes, Shared.EncryptionFunc, Shared.SetupSteps,
   Setup.LoggingFunc, Setup.ScriptRunner, Shared.SetupTypes, Shared.EncryptionFunc, Shared.SetupSteps,
@@ -737,26 +736,6 @@ end;
 
 
 { TWizardForm }
 { TWizardForm }
 
 
-function SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
-var
-  TargetArea, Difference, SmallestDifference, I: Integer;
-begin
-  if WizardImages.Count <> 1 then begin
-    { Find the image with the smallest area difference compared to the target area. }
-    TargetArea := TargetWidth*TargetHeight;
-    SmallestDifference := -1;
-    Result := nil;
-    for I := 0 to WizardImages.Count-1 do begin
-      Difference := Abs(TargetArea-WizardImages[I].Width*WizardImages[I].Height);
-      if (SmallestDifference = -1) or (Difference < SmallestDifference) then begin
-        Result := WizardImages[I];
-        SmallestDifference := Difference;
-      end;
-    end;
-  end else
-    Result := WizardImages[0];
-end;
-
 constructor TWizardForm.Create(AOwner: TComponent);
 constructor TWizardForm.Create(AOwner: TComponent);
 { Do all initialization of the wizard form. We're overriding Create instead of
 { Do all initialization of the wizard form. We're overriding Create instead of
   using the FormCreate event, because if an exception is raised in FormCreate
   using the FormCreate event, because if an exception is raised in FormCreate
@@ -2351,22 +2330,6 @@ begin
   EnableMenuItem(GetSystemMenu(Handle, False), SC_CLOSE, MF_BYCOMMAND or Flags);
   EnableMenuItem(GetSystemMenu(Handle, False), SC_CLOSE, MF_BYCOMMAND or Flags);
 end;
 end;
 
 
-procedure TWizardForm.SetBackImage(const BackImages: TWizardImages; const Stretch, Center: Boolean;
-  const Opacity: Byte; const Redraw: Boolean);
-begin
-  if not CustomWizardBackground then
-    InternalError('Cannot set a background image at this time: custom wizard background not active');
-  const Graphic = SelectBestImage(BackImages, ClientWidth, ClientHeight);
-  TFormBackgroundStyleHook.Graphic := Graphic;
-  TFormBackgroundStyleHook.GraphicTarget := Self;
-  TFormBackgroundStyleHook.Stretch := Stretch;
-  TFormBackgroundStyleHook.Center := Center;
-  TFormBackgroundStyleHook.Opacity := Opacity;
-  TNewCheckListBox.ComplexParentBackground := Graphic <> nil;
-  if Redraw and HandleAllocated then
-    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN);
-end;
-
 procedure TWizardForm.SetCurPage(const NewPageID: Integer);
 procedure TWizardForm.SetCurPage(const NewPageID: Integer);
 { Changes which page is currently visible }
 { Changes which page is currently visible }
 begin
 begin

+ 1 - 1
whatsnew.htm

@@ -95,7 +95,7 @@ For conditions of distribution and use, see <a href="files/is/license.txt">LICEN
 <span class="key">WizardBackColorDynamicDark</span>=#570c22
 <span class="key">WizardBackColorDynamicDark</span>=#570c22
 <span class="com">; On wizard pages blend the background image and color together</span>
 <span class="com">; On wizard pages blend the background image and color together</span>
 <span class="key">WizardBackImageOpacity</span>=150</code></pre></li>
 <span class="key">WizardBackImageOpacity</span>=150</code></pre></li>
-  <li>Pascal Scripting: Added new support function <tt>WizardSetBackImage</tt> to set, update, or remove the background image at runtime.<br/>
+  <li>Pascal Scripting: Added new support function <tt>WizardSetBackImage</tt> to set, update, or remove the background image at runtime. Can not only be used in Setup, but also in Uninstall.<br/>
       See the <a href="https://jrsoftware.org/ishelp/index.php?topic=isxfunc_wizardsetbackimage">new help topic</a> for an example, and see new function <tt>BackImageButtonOnClick</tt> in <i><a href="https://raw.githubusercontent.com/jrsoftware/issrc/refs/heads/main/Examples/CodeClasses.iss">CodeClasses.iss</a></i> for another example.</li>
       See the <a href="https://jrsoftware.org/ishelp/index.php?topic=isxfunc_wizardsetbackimage">new help topic</a> for an example, and see new function <tt>BackImageButtonOnClick</tt> in <i><a href="https://raw.githubusercontent.com/jrsoftware/issrc/refs/heads/main/Examples/CodeClasses.iss">CodeClasses.iss</a></i> for another example.</li>
 </ul>
 </ul>