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.
This commit is contained in:
Martijn Laan
parent
c874a865a6
commit
19ff004a89
@ -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
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
58
iscrypt.iss
58
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
|
||||
|
||||
@ -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>
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user