Pascal Scripting change: Added new InitializeBitmapImageFromIcon support function. Use this in iscrypt.iss. Had to use seperate function instead of just adding it as a class method because the latter doesn't work with an array of integer parameter.

Components/BitmapImage.pas

@@ -41,7 +41,7 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function InitializeFromIcon(const Instance: HINST; const ResourceName: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
+    function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
   published
     property Align;
     property Anchors;
@@ -82,8 +82,9 @@ begin
   RegisterComponents('JR', [TBitmapImage]);
 end;
 
-function TBitmapImage.InitializeFromIcon(const Instance: HINST; const ResourceName: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
+function TBitmapImage.InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
 var
+  Flags: Cardinal;
   Handle: THandle;
   Icon: TIcon;
   I, Size: Integer;
@@ -100,9 +101,12 @@ begin
     Size := Min(Width, Height);
 
   { Load the desired icon }
-  Handle := LoadImage(Instance, ResourceName, IMAGE_ICON, Size, Size, LR_DEFAULTCOLOR);
+  Flags := LR_DEFAULTCOLOR;
+  if Instance = 0 then
+    Flags := Flags or LR_LOADFROMFILE;
+  Handle := LoadImage(Instance, Name, IMAGE_ICON, Size, Size, Flags);
   if Handle = 0 then
-    Handle := LoadImage(Instance, ResourceName, IMAGE_ICON, 0, 0, LR_DEFAULTCOLOR);
+    Handle := LoadImage(Instance, Name, IMAGE_ICON, 0, 0, Flags);
   if Handle <> 0 then begin
     Icon := TIcon.Create;
     try

ISHelp/isxfunc.xml

@@ -2597,6 +2597,28 @@ end;</pre></example>
         <prototype>function ScaleY(Y: Integer): Integer;</prototype>
         <description><p>Takes a Y coordinate or height and returns it scaled to fit the size of the current dialog font. If the dialog font is 8-point MS Sans Serif and the user is running Windows in Small Fonts (96 dpi), then Y is returned unchanged.</p></description>
       </function>
+      <function>
+        <name>InitializeBitmapImageFromIcon</name>
+        <prototype>function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;</prototype>
+        <description><p>Initializes the given bitmap image with the given icon using the given background color for transparent parts. The bitmap image should be scaled already and then the function will load the largest fitting icon which has a size from the given array of sizes. The array must be sorted already from smallest to highest size. Returns True if the icon could be loaded, False otherwise.</p></description>
+        <example><pre>procedure InitializeWizard;
+var
+  Page: TWizardPage;
+  BitmapImage: TBitmapImage;
+begin
+  Page := CreateCustomPage(wpWelcome, 'Test', 'Test');
+
+  BitmapImage := TBitmapImage.Create(Page);
+  
+  with BitmapImage do begin
+    Width := ScaleX(32);
+    Height := ScaleY(32);
+    Parent := Page.Surface;
+  end;
+
+  InitializeBitmapImageFromIcon(BitmapImage, 'MyProg.ico', Page.SurfaceColor, [32, 48, 64]);
+end;</pre></example>
+      </function>
     </subcategory>
   </category>
   <category>

Projects/ScriptFunc.pas

@@ -347,7 +347,7 @@ const
   );
 
   { Other }
-  OtherTable: array [0..32] of AnsiString =
+  OtherTable: array [0..33] of AnsiString =
   (
     'procedure BringToFrontAndRestore;',
     'function WizardDirValue: String;',
@@ -381,7 +381,8 @@ const
     'function GetUninstallProgressForm: TUninstallProgressForm;',
     'function CreateCallback(Method: AnyMethod): Longword;',
     'function IsDotNetInstalled(const MinVersion: TDotNetVersion; const MinServicePack: Cardinal): Boolean;',
-    'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;'
+    'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;',
+    'function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;'
   );
 
 implementation

Projects/ScriptFunc_R.pas

@@ -27,7 +27,7 @@ uses
   Struct, ScriptDlg, Main, PathFunc, CmnFunc, CmnFunc2, FileClass, RedirFunc,
   Install, InstFunc, InstFnc2, Msgs, MsgIDs, NewDisk, BrowseFunc, Wizard, VerInfo,
   SetupTypes, Int64Em, MD5, SHA1, Logging, SetupForm, RegDLL, Helper,
-  SpawnClient, UninstProgressForm, ASMInline, DotNet, Msi;
+  SpawnClient, UninstProgressForm, ASMInline, DotNet, Msi, BitmapImage;
 
 var
   ScaleBaseUnitsInitialized: Boolean;
@@ -625,12 +625,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);
@@ -1907,6 +1907,8 @@ var
   AnsiS: AnsiString;
   Arr: TPSVariantIFC;
   ErrorCode: Cardinal;
+  N, I: Integer;
+  AscendingTrySizes: array of Integer;
 begin
   PStart := Stack.Count-1;
   Result := True;
@@ -2045,6 +2047,13 @@ begin
     Stack.SetBool(PStart, IsMsiProductInstalled(Stack.GetString(PStart-1), Stack.GetInt64(PStart-2), ErrorCode));
     if ErrorCode <> 0 then
       raise Exception.Create(Win32ErrorString(ErrorCode));
+  end else if Proc.Name = 'INITIALIZEBITMAPIMAGEFROMICON' then begin
+    Arr := NewTPSVariantIFC(Stack[PStart-4], True);
+    N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
+    SetLength(AscendingTrySizes, N);
+    for I := 0 to N-1 do
+      AscendingTrySizes[I] := VNGetInt(PSGetArrayField(Arr, I));
+    Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
   end else
     Result := False;
 end;

iscrypt.iss

@@ -3,9 +3,11 @@
 // Must be included before adding [Files] entries
 //
 #if FileExists('iscrypt-custom.ico')
-  #define iscryptico 'iscrypt-custom.ico'
+  #define iscryptico      'iscrypt-custom.ico'
+  #define iscrypticosizes '[32, 48, 64]'
 #else
-  #define iscryptico 'iscrypt.ico'
+  #define iscryptico      'iscrypt.ico'
+  #define iscrypticosizes '[32]'
 #endif
 //
 [Files]
@@ -20,18 +22,6 @@ var
   ISCryptPage: TWizardPage;
   ISCryptCheckBox: TCheckBox;
 
-function GetModuleHandle(lpModuleName: LongInt): LongInt;
-external 'GetModuleHandleA@kernel32.dll stdcall';
-function ExtractIcon(hInst: LongInt; lpszExeFileName: String; nIconIndex: LongInt): LongInt;
-external 'ExtractIconW@shell32.dll stdcall';
-function DrawIconEx(hdc: LongInt; xLeft, yTop: Integer; hIcon: LongInt; cxWidth, cyWidth: Integer; istepIfAniCur: LongInt; hbrFlickerFreeDraw, diFlags: LongInt): LongInt;
-external 'DrawIconEx@user32.dll stdcall';
-function DestroyIcon(hIcon: LongInt): LongInt;
-external 'DestroyIcon@user32.dll stdcall';
-
-const
-  DI_NORMAL = 3;
-  
 procedure CreateCustomOption(Page: TWizardPage; ACheckCaption: String; var CheckBox: TCheckBox; PreviousControl: TControl);
 begin
   CheckBox := TCheckBox.Create(Page);
@@ -49,41 +39,23 @@ function CreateCustomOptionPage(AAfterId: Integer; ACaption, ASubCaption, AIconF
   ACheckCaption: String; var CheckBox: TCheckBox): TWizardPage;
 var
   Page: TWizardPage;
-  Rect: TRect;
+  BitmapImage: TBitmapImage;
-  hIcon: LongInt;
   Label1, Label2: TNewStaticText;
 begin
   Page := CreateCustomPage(AAfterID, ACaption, ASubCaption);
   
-  try
+  AIconFileName := ExpandConstant('{tmp}\' + AIconFileName);
-    AIconFileName := ExpandConstant('{tmp}\' + AIconFileName);
+  if not FileExists(AIconFileName) then
-    if not FileExists(AIconFileName) then
+    ExtractTemporaryFile(ExtractFileName(AIconFileName));
-      ExtractTemporaryFile(ExtractFileName(AIconFileName));
 
-    Rect.Left := 0;
+  BitmapImage := TBitmapImage.Create(Page);
-    Rect.Top := 0;
+  with BitmapImage do begin
-    Rect.Right := 32;
+    Width := ScaleX(32);
-    Rect.Bottom := 32;
+    Height := ScaleY(32);
-
+    Parent := Page.Surface;
-    hIcon := ExtractIcon(GetModuleHandle(0), AIconFileName, 0);
-    try
-      with TBitmapImage.Create(Page) do begin
-        with Bitmap do begin
-          Width := 32;
-          Height := 32;
-          Canvas.Brush.Color := Page.SurfaceColor;
-          Canvas.FillRect(Rect);
-          DrawIconEx(Canvas.Handle, 0, 0, hIcon, 32, 32, 0, 0, DI_NORMAL);
-        end;
-        Width := Bitmap.Width;
-        Height := Bitmap.Width;
-        Parent := Page.Surface;
-      end;
-    finally
-      DestroyIcon(hIcon);
-    end;
-  except
   end;
+  
+  InitializeBitmapImageFromIcon(BitmapImage, AIconFileName, Page.SurfaceColor, {#iscrypticosizes});
 
   Label1 := TNewStaticText.Create(Page);
   with Label1 do begin

whatsnew.htm

@@ -48,6 +48,7 @@ For conditions of distribution and use, see <a href="https://jrsoftware.org/file
   <li>Updated the folder, group, and stop icons used by Setup's <i>Select Destination Location</i>, <i>Select Start Menu Folder</i>, and <i>Preparing to Install</i> wizard pages.</li>
   <li>Updated the disk icon used by Setup's <i>Setup Needs the Next Disk</i> form.</li>
   <li>All these icon and images updates include the automatic use of larger versions on higher DPI settings.</li>
+  <li>Pascal Scripting change: Added new <tt>InitializeBitmapImageFromIcon</tt> support function.</li>
 </ul>
 <p><span class="head2">Other changes</span></p>
 <ul>