From 19ff004a896311c911feb62a26fcbfc3413d3f1a Mon Sep 17 00:00:00 2001 From: Martijn Laan Date: Mon, 19 Apr 2021 19:40:24 +0200 Subject: [PATCH] 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 | 12 +++++--- ISHelp/isxfunc.xml | 22 +++++++++++++++ Projects/ScriptFunc.pas | 5 ++-- Projects/ScriptFunc_R.pas | 15 ++++++++-- iscrypt.iss | 58 ++++++++++---------------------------- whatsnew.htm | 1 + 6 files changed, 61 insertions(+), 52 deletions(-) diff --git a/Components/BitmapImage.pas b/Components/BitmapImage.pas index 901eea57..8fd9a5ac 100644 --- a/Components/BitmapImage.pas +++ b/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 diff --git a/ISHelp/isxfunc.xml b/ISHelp/isxfunc.xml index ad736820..5431596e 100644 --- a/ISHelp/isxfunc.xml +++ b/ISHelp/isxfunc.xml @@ -2597,6 +2597,28 @@ end; function ScaleY(Y: Integer): Integer;

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.

 + + InitializeBitmapImageFromIcon + function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean; +

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.

 + 
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;
 + diff --git a/Projects/ScriptFunc.pas b/Projects/ScriptFunc.pas index 2242ca9a..fcd946cc 100644 --- a/Projects/ScriptFunc.pas +++ b/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 diff --git a/Projects/ScriptFunc_R.pas b/Projects/ScriptFunc_R.pas index 7f72d292..e05af074 100644 --- a/Projects/ScriptFunc_R.pas +++ b/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; diff --git a/iscrypt.iss b/iscrypt.iss index c1fe9be5..4dcc6ff5 100644 --- a/iscrypt.iss +++ b/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; - 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 diff --git a/whatsnew.htm b/whatsnew.htm index a14e66bf..9aabd625 100644 --- a/whatsnew.htm +++ b/whatsnew.htm @@ -48,6 +48,7 @@ For conditions of distribution and use, see Other changes