Pascal Scripting change: Added new InitializeBitmapImageFromIcon supp…

…ort 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 @@   TBitmapImage = class(TGraphicControl)
   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 @@ procedure Register;
   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 @@ function TBitmapImage.InitializeFromIcon(const Instance: HINST; const ResourceNa
     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 @@ interface
   );
 
   { Other }
-  OtherTable: array [0..32] of AnsiString =
+  OtherTable: array [0..33] of AnsiString =
   (
     'procedure BringToFrontAndRestore;',
     'function WizardDirValue: String;',
@@ -381,7 +381,8 @@ interface
     '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 @@ implementation
   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 @@ function CmnFunc2Proc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack:
     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 @@ function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPS
   AnsiS: AnsiString;
   Arr: TPSVariantIFC;
   ErrorCode: Cardinal;
+  N, I: Integer;
+  AscendingTrySizes: array of Integer;
 begin
   PStart := Stack.Count-1;
   Result := True;
@@ -2045,6 +2047,13 @@ function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPS
     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 '[email protected] stdcall';
-function ExtractIcon(hInst: LongInt; lpszExeFileName: String; nIconIndex: LongInt): LongInt;
-external '[email protected] stdcall';
-function DrawIconEx(hdc: LongInt; xLeft, yTop: Integer; hIcon: LongInt; cxWidth, cyWidth: Integer; istepIfAniCur: LongInt; hbrFlickerFreeDraw, diFlags: LongInt): LongInt;
-external '[email protected] stdcall';
-function DestroyIcon(hIcon: LongInt): LongInt;
-external '[email protected] 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;
-  hIcon: LongInt;
+  BitmapImage: TBitmapImage;
   Label1, Label2: TNewStaticText;
 begin
   Page := CreateCustomPage(AAfterID, ACaption, ASubCaption);
   
-  try
-    AIconFileName := ExpandConstant('{tmp}\' + AIconFileName);
-    if not FileExists(AIconFileName) then
-      ExtractTemporaryFile(ExtractFileName(AIconFileName));
+  AIconFileName := ExpandConstant('{tmp}\' + AIconFileName);
+  if not FileExists(AIconFileName) then
+    ExtractTemporaryFile(ExtractFileName(AIconFileName));
 
-    Rect.Left := 0;
-    Rect.Top := 0;
-    Rect.Right := 32;
-    Rect.Bottom := 32;
-
-    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
+  BitmapImage := TBitmapImage.Create(Page);
+  with BitmapImage do begin
+    Width := ScaleX(32);
+    Height := ScaleY(32);
+    Parent := Page.Surface;
   end;
+  
+  InitializeBitmapImageFromIcon(BitmapImage, AIconFileName, Page.SurfaceColor, {#iscrypticosizes});
 
   Label1 := TNewStaticText.Create(Page);
   with Label1 do begin

whatsnew.htm

@@ -48,6 +48,7 @@
   <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>