Browse Source

Added support for multiple wizard images, selecting best match at run time.

Martijn Laan 7 years ago
parent
commit
342d78bddd
3 changed files with 113 additions and 50 deletions
  1. 53 25
      Projects/Compile.pas
  2. 29 11
      Projects/Main.pas
  3. 31 14
      Projects/Wizard.pas

+ 53 - 25
Projects/Compile.pas

@@ -501,6 +501,7 @@ type
     procedure WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer);
     procedure WriteCompiledCodeText(const CompiledCodeText: Ansistring);
     procedure WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: AnsiString);
+    function CreateMemoryStreamsFromFiles(const AFiles: String): TList;
   public
     AppData: Longint;
     CallbackProc: TCompilerCallbackProc;
@@ -701,6 +702,39 @@ begin
   end;
 end;
 
+function ExtractStr(var S: String; const Separator: Char): String;
+var
+  I: Integer;
+begin
+  repeat
+    I := PathPos(Separator, S);
+    if I = 0 then I := Length(S)+1;
+    Result := Trim(Copy(S, 1, I-1));
+    S := Trim(Copy(S, I+1, Maxint));
+  until (Result <> '') or (S = '');
+end;
+
+function TSetupCompiler.CreateMemoryStreamsFromFiles(const AFiles: String): TList;
+var
+  S, Filename: String;
+begin
+  Result := TList.Create;
+  try
+    S := AFiles;
+    while True do begin
+      Filename := ExtractStr(S, ',');
+      if Filename = '' then
+        Break;
+      Filename := PrependSourceDirName(Filename);
+      AddStatus(Format(SCompilerStatusReadingInFile, [FileName]));
+      Result.Add(CreateMemoryStreamFromFile(FileName));
+    end;
+  except
+    Result.Free;
+    raise Exception.CreateFmt(SCompilerReadError, [Filename, GetExceptMessage]);
+  end;
+end;
+
 function FileSizeAndCRCIs(const Filename: String; const Size: Cardinal;
   const CRC: Longint): Boolean;
 var
@@ -2949,18 +2983,6 @@ begin
   end;
 end;
 
-function ExtractStr(var S: String; const Separator: Char): String;
-var
-  I: Integer;
-begin
-  repeat
-    I := PathPos(Separator, S);
-    if I = 0 then I := Length(S)+1;
-    Result := Trim(Copy(S, 1, I-1));
-    S := Trim(Copy(S, I+1, Maxint));
-  until (Result <> '') or (S = '');
-end;
-
 function ExtractFlag(var S: String; const FlagStrs: array of PChar): Integer;
 var
   I: Integer;
@@ -7661,8 +7683,8 @@ var
   SetupFile: TFile;
   ExeFile: TFile;
   LicenseText, InfoBeforeText, InfoAfterText: AnsiString;
-  WizardImage: TMemoryStream;
-  WizardSmallImage: TMemoryStream;
+  WizardImages: TList;
+  WizardSmallImages: TList;
   DecompressorDLL, DecryptionDLL: TMemoryStream;
 
   SetupLdrOffsetTable: TSetupLdrOffsetTable;
@@ -7764,8 +7786,12 @@ var
         SECompressedBlockWrite(W, UninstallRunEntries[J]^, SizeOf(TSetupRunEntry),
           SetupRunEntryStrings, SetupRunEntryAnsiStrings);
 
-      WriteStream(WizardImage, W);
-      WriteStream(WizardSmallImage, W);
+      W.Write(WizardImages.Count, SizeOf(LongInt));
+      for J := 0 to WizardImages.Count-1 do
+        WriteStream(WizardImages[J], W);
+      W.Write(WizardSmallImages.Count, SizeOf(LongInt));
+      for J := 0 to WizardSmallImages.Count-1 do
+        WriteStream(WizardSmallImages[J], W);
       if SetupHeader.CompressMethod in [cmZip, cmBzip] then
         WriteStream(DecompressorDLL, W);
       if shEncryptionUsed in SetupHeader.Options then
@@ -8360,8 +8386,8 @@ begin
   InitPreprocessor;
   InitLZMADLL;
 
-  WizardImage := nil;
-  WizardSmallImage := nil;
+  WizardImages := nil;
+  WizardSmallImages := nil;
   SetupE32 := nil;
   DecompressorDLL := nil;
   DecryptionDLL := nil;
@@ -8636,12 +8662,10 @@ begin
     { Read wizard image }
     LineNumber := SetupDirectiveLines[ssWizardImageFile];
     AddStatus(Format(SCompilerStatusReadingFile, ['WizardImageFile']));
-    AddStatus(Format(SCompilerStatusReadingInFile, [PrependSourceDirName(WizardImageFile)]));
-    WizardImage := CreateMemoryStreamFromFile(PrependSourceDirName(WizardImageFile));
+    WizardImages := CreateMemoryStreamsFromFiles(WizardImageFile);
     LineNumber := SetupDirectiveLines[ssWizardSmallImageFile];
     AddStatus(Format(SCompilerStatusReadingFile, ['WizardSmallImageFile']));
-    AddStatus(Format(SCompilerStatusReadingInFile, [PrependSourceDirName(WizardSmallImageFile)]));
-    WizardSmallImage := CreateMemoryStreamFromFile(PrependSourceDirName(WizardSmallImageFile));
+    WizardSmallImages := CreateMemoryStreamsFromFiles(WizardSmallImageFile);
     LineNumber := 0;
 
     { Prepare Setup executable & signed uninstaller data }
@@ -8654,7 +8678,7 @@ begin
     { Read languages:
 
       Non Unicode:
-      
+
       1. Read Default.isl messages:
 
       ReadDefaultMessages calls EnumMessages for Default.isl's [Messages], with Ext set to -2.
@@ -9014,8 +9038,12 @@ begin
     DecryptionDLL.Free;
     DecompressorDLL.Free;
     SetupE32.Free;
-    WizardSmallImage.Free;
-    WizardImage.Free;
+    for I := WizardSmallImages.Count-1 downto 0 do
+      TStream(WizardSmallImages[I]).Free;
+    WizardSmallImages.Free;
+    for I := WizardImages.Count-1 downto 0 do
+      TStream(WizardImages[I]).Free;
+    WizardImages.Free;
     FreeListItems(LanguageEntries, SetupLanguageEntryStrings, SetupLanguageEntryAnsiStrings);
     FreeListItems(CustomMessageEntries, SetupCustomMessageEntryStrings, SetupCustomMessageEntryAnsiStrings);
     FreeListItems(PermissionEntries, SetupPermissionEntryStrings, SetupPermissionEntryAnsiStrings);

+ 29 - 11
Projects/Main.pas

@@ -131,8 +131,8 @@ var
   SetupHeader: TSetupHeader;
   LangOptions: TSetupLanguageEntry;
   Entries: array[TEntryType] of TList;
-  WizardImage: TBitmap;
-  WizardSmallImage: TBitmap;
+  WizardImages: TList;
+  WizardSmallImages: TList;
   CloseApplicationsFilterList: TStringList;
 
   { User options }
@@ -2551,7 +2551,7 @@ var
     end;
   end;
 
-  procedure ReadWizardImage(var WizardImage: TBitmap; const R: TCompressedBlockReader);
+  function ReadWizardImage(const R: TCompressedBlockReader): TBitmap;
   var
     MemStream: TMemoryStream;
   begin
@@ -2559,9 +2559,9 @@ var
     try
       ReadFileIntoStream(MemStream, R);
       MemStream.Seek(0, soFromBeginning);
-      WizardImage := TAlphaBitmap.Create;
-      TAlphaBitmap(WizardImage).AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
-      WizardImage.LoadFromStream(MemStream);
+      Result := TAlphaBitmap.Create;
+      TAlphaBitmap(Result).AlphaFormat := TAlphaFormat(SetupHeader.WizardImageAlphaFormat);
+      Result.LoadFromStream(MemStream);
     finally
       MemStream.Free;
     end;
@@ -2739,7 +2739,7 @@ var
 var
   ParamName, ParamValue: String;
   StartParam: Integer;
-  I: Integer;
+  I, N: Integer;
   IsRespawnedProcess, EnableLogging, WantToSuppressMsgBoxes, Res: Boolean;
   DebugWndValue: HWND;
   LogFilename: String;
@@ -3021,8 +3021,13 @@ begin
           Integer(@PSetupRunEntry(nil).OnlyBelowVersion));
 
         { Wizard image }
-        ReadWizardImage(WizardImage, Reader);
-        ReadWizardImage(WizardSmallImage, Reader);
+
+        Reader.Read(N, SizeOf(LongInt));
+        for I := 0 to N-1 do
+          WizardImages.Add(ReadWizardImage(Reader));
+        Reader.Read(N, SizeOf(LongInt));
+        for I := 0 to N-1 do
+          WizardSmallImages.Add(ReadWizardImage(Reader));
         { Decompressor DLL }
         DecompressorDLL := nil;
         if SetupHeader.CompressMethod in [cmZip, cmBzip] then begin
@@ -4357,6 +4362,18 @@ begin
   end;
 end;
 
+procedure FreeWizardImages;
+var
+  I: Integer;
+begin
+  for I := WizardImages.Count-1 downto 0 do
+    TBitmap(WizardImages[I]).Free;
+  FreeAndNil(WizardImages);
+  for I := WizardSmallImages.Count-1 downto 0 do
+    TBitmap(WizardSmallImages[I]).Free;
+  FreeAndNil(WizardSmallImages);
+end;
+
 initialization
   IsNT := UsingWinNT;
   InitIsWin64AndProcessorArchitecture;
@@ -4374,12 +4391,13 @@ initialization
   DeleteFilesAfterInstallList := TStringList.Create;
   DeleteDirsAfterInstallList := TStringList.Create;
   CloseApplicationsFilterList := TStringList.Create;
+  WizardImages := TList.Create;
+  WizardSmallImages := TList.Create;
   SHGetKnownFolderPathFunc := GetProcAddress(SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32,
     SEM_NOOPENFILEERRORBOX), 'SHGetKnownFolderPath');
 
 finalization
-  FreeAndNil(WizardImage);
-  FreeAndNil(WizardSmallImage);
+  FreeWizardImages;
   FreeAndNil(CloseApplicationsFilterList);
   FreeAndNil(DeleteDirsAfterInstallList);
   FreeAndNil(DeleteFilesAfterInstallList);

+ 31 - 14
Projects/Wizard.pas

@@ -664,6 +664,23 @@ constructor TWizardForm.Create(AOwner: TComponent);
     end;
   end;
 
+  function SelectBestImage(WizardImages: TList; TargetWidth, TargetHeight: Integer): TBitmap;
+  var
+    TargetArea, Difference, SmallestDifference, I: Integer;
+  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-TBitmap(WizardImages[I]).Width*TBitmap(WizardImages[I]).Height);
+      if (SmallestDifference = -1) or (Difference < SmallestDifference) then begin
+        Result := WizardImages[I];
+        SmallestDifference := Difference;
+      end;
+    end;
+  end;
+
 var
   X, W1, W2: Integer;
   SystemMenu: HMENU;
@@ -686,22 +703,22 @@ begin
 {$IFDEF IS_D7}
   MainPanel.ParentBackground := False;
 {$ENDIF}
-
   { Prior to scaling the form, shrink WizardSmallBitmapImage if it's currently
     larger than WizardSmallImage. This way, stretching will not occur if the
     user specifies a smaller-than-default image and WizardImageStretch=yes,
     except if the form has to be scaled (e.g. due to Large Fonts). }
-  I := WizardSmallBitmapImage.Height - WizardSmallImage.Height;
-  if I > 0 then begin
-    WizardSmallBitmapImage.Height := WizardSmallBitmapImage.Height - I;
-    WizardSmallBitmapImage.Top := WizardSmallBitmapImage.Top + (I div 2);
-  end;
-  I := WizardSmallBitmapImage.Width - WizardSmallImage.Width;
-  if I > 0 then begin
-    WizardSmallBitmapImage.Width := WizardSmallBitmapImage.Width - I;
-    WizardSmallBitmapImage.Left := WizardSmallBitmapImage.Left + (I div 2);
+  if WizardSmallImages.Count = 1 then begin
+    I := WizardSmallBitmapImage.Height - TBitmap(WizardSmallImages[0]).Height;
+    if I > 0 then begin
+      WizardSmallBitmapImage.Height := WizardSmallBitmapImage.Height - I;
+      WizardSmallBitmapImage.Top := WizardSmallBitmapImage.Top + (I div 2);
+    end;
+    I := WizardSmallBitmapImage.Width - TBitmap(WizardSmallImages[0]).Width;
+    if I > 0 then begin
+      WizardSmallBitmapImage.Width := WizardSmallBitmapImage.Width - I;
+      WizardSmallBitmapImage.Left := WizardSmallBitmapImage.Left + (I div 2);
+    end;
   end;
-
   InitializeFont;
   if shWindowVisible in SetupHeader.Options then
     CenterInsideControl(MainForm, True)
@@ -746,13 +763,13 @@ begin
   BackButton.Left := X;
 
   { Initialize images }
-  WizardBitmapImage.Bitmap := WizardImage;
+  WizardBitmapImage.Bitmap := SelectBestImage(WizardImages, WizardBitmapImage.Width, WizardBitmapImage.Height);
   WizardBitmapImage.Center := True;
   WizardBitmapImage.Stretch := (shWizardImageStretch in SetupHeader.Options);
-  WizardBitmapImage2.Bitmap := WizardImage;
+  WizardBitmapImage2.Bitmap := WizardBitmapImage.Bitmap;
   WizardBitmapImage2.Center := True;
   WizardBitmapImage2.Stretch := (shWizardImageStretch in SetupHeader.Options);
-  WizardSmallBitmapImage.Bitmap := WizardSmallImage;
+  WizardSmallBitmapImage.Bitmap := SelectBestImage(WizardSmallImages, WizardSmallBitmapImage.Width, WizardSmallBitmapImage.Height);
   WizardSmallBitmapImage.Stretch := (shWizardImageStretch in SetupHeader.Options);
   PreparingErrorBitmapImage.Bitmap.Handle := LoadBitmap(HInstance, 'STOPIMAGE');
   PreparingErrorBitmapImage.ReplaceColor := clSilver;