Kaynağa Gözat

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 5 gün önce
ebeveyn
işleme
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 IsWindows10: Boolean;
 function IsWindows11: Boolean;
+function SelectBestImage(WizardImages: TWizardImages; TargetWidth, TargetHeight: Integer): TGraphic;
 
 implementation
 
@@ -288,6 +289,26 @@ type
 
 { 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;
 begin
   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;
       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
       const WizardImages = TWizardImages.Create(False);
       try
         const BackImages = Stack.GetClassArray(PStart);
         for var BackImage in BackImages do
           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
         WizardImages.Free;
       end;

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

@@ -29,7 +29,8 @@ interface
 
 uses
   Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
-  UIStateForm;
+  UIStateForm,
+  Setup.MainFunc;
 
 type
   TSetupForm = class(TUIStateForm)
@@ -73,6 +74,7 @@ type
     class procedure SetCtlParent(const AControl: TControl; const AParent: TWinControl);
     function ScalePixelsX(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 ShouldSizeY: Boolean;
     function ShowModal: Integer; override;
@@ -101,9 +103,9 @@ implementation
 
 uses
   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,
-  Setup.MainFunc, Setup.InstFunc;
+  Setup.InstFunc;
 
 var
   WM_QueryCancelAutoPlay: UINT;
@@ -737,6 +739,22 @@ begin
   Result := ScalePixelsY(FOrigBaseUnitY, FBaseUnitY, N);
 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);
 { To be called when a control is added after the form has already been created }
 begin

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

@@ -238,7 +238,6 @@ type
     procedure SetCurPage(const NewPageID: Integer);
     procedure SelectComponents(const ASelectComponents: 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);
     function ValidateDirEdit: Boolean;
     function ValidateGroupEdit: Boolean;
@@ -343,7 +342,7 @@ implementation
 
 uses
   ShellApi, ShlObj, Types, Generics.Collections, Themes,
-  PathFunc, RestartManager, SHA256, FormBackgroundStyleHook,
+  PathFunc, RestartManager, SHA256,
   SetupLdrAndSetup.Messages, Setup.MainForm, Shared.CommonFunc.Vcl,
   Shared.CommonFunc, Setup.InstFunc, Setup.SelectFolderForm, Setup.FileExtractor,
   Setup.LoggingFunc, Setup.ScriptRunner, Shared.SetupTypes, Shared.EncryptionFunc, Shared.SetupSteps,
@@ -737,26 +736,6 @@ end;
 
 { 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);
 { 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
@@ -2351,22 +2330,6 @@ begin
   EnableMenuItem(GetSystemMenu(Handle, False), SC_CLOSE, MF_BYCOMMAND or Flags);
 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);
 { Changes which page is currently visible }
 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="com">; On wizard pages blend the background image and color together</span>
 <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>
 </ul>