Branch: FormBackgroundStyleHook

Components/BitmapImage.pas

@@ -41,6 +41,7 @@   TBitmapImageImplementation = record
     procedure Init(const AControl: TControl; const AAutoSizeExtraWidth: Integer = 0;
       const AAutoSizeExtraHeight: Integer = 0);
     procedure DeInit;
+    class function AdjustColorForStyle(const Control: TControl; const Color: TColor): TColor; static;
     function GetInitializeSize(const AscendingTrySizes: array of Integer): Integer;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     function InitializeFromStockIcon(const Siid: SHSTOCKICONID; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
@@ -151,6 +152,23 @@ procedure TBitmapImageImplementation.DeInit;
   FreeAndNil(Bitmap);
 end;
 
+class function TBitmapImageImplementation.AdjustColorForStyle(const Control: TControl;
+  const Color: TColor): TColor;
+begin
+  Result := Color;
+  if (Result = clBtnFace) or (Result = clWindow) then begin
+    var LStyle := StyleServices(Control);
+    if not LStyle.Enabled or LStyle.IsSystemStyle then
+      LStyle := nil;
+    if LStyle <> nil then begin
+      if Result = clBtnFace then
+        Result := LStyle.GetStyleColor(scPanel)
+      else
+        Result := LStyle.GetStyleColor(scWindow);
+    end;
+  end;
+end;
+
 function TBitmapImageImplementation.GetInitializeSize(const AscendingTrySizes: array of Integer): Integer;
 begin
   { Find the largest regular icon size smaller than the scaled image }
@@ -344,7 +362,7 @@ procedure TBitmapImageImplementation.Paint(const Sender: TObject; const Canvas:
 
   var W, H: Integer;
   var Bmp: TBitmap;
-  if Stretch then begin
+  if Stretch and not Bitmap.Empty then begin
     W := R.Width;
     H := R.Height;
     Bmp := StretchedBitmap;
@@ -376,17 +394,8 @@ procedure TBitmapImageImplementation.Paint(const Sender: TObject; const Canvas:
 
   if (BackColor <> clNone) and (Is32Bit or (Bmp.Width < FControl.Width) or (Bmp.Height < FControl.Height)) then begin
     var BrushColor := BackColor;
-    if ((BrushColor = clBtnFace) or (BrushColor = clWindow)) and (Sender is TControl) then begin
-      var LStyle := StyleServices(TControl(Sender));
-      if not LStyle.Enabled or LStyle.IsSystemStyle then
-        LStyle := nil;
-      if LStyle <> nil then begin
-        if BrushColor = clBtnFace then
-          BrushColor := LStyle.GetStyleColor(scPanel)
-        else
-          BrushColor := LStyle.GetStyleColor(scWindow);
-      end;
-    end;
+    if Sender is TControl then
+      BrushColor := AdjustColorForStyle(TControl(Sender), BrushColor);
     Canvas.Brush.Style := bsSolid;
     Canvas.Brush.Color := BrushColor;
     Canvas.FillRect(R);
@@ -398,24 +407,27 @@ procedure TBitmapImageImplementation.Paint(const Sender: TObject; const Canvas:
     Canvas.Rectangle(0, 0, FControl.Width, FControl.Height);
   end;
 
-  var X := R.Left;
-  var Y := R.Top;
-  if Center then begin
-    Inc(X, (R.Width - W) div 2);
-    if X < 0 then
-      X := 0;
-    Inc(Y, (R.Height - H) div 2);
-    if Y < 0 then
-      Y := 0;
-  end;
 
-  if not Is32bit and (ReplaceColor <> clNone) and (ReplaceWithColor <> clNone) then begin
-    Canvas.Brush.Color := ReplaceWithColor;
-    Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), ReplaceColor);
-  end else if Opacity <> 255 then
-    Canvas.Draw(X, Y, Bmp, Opacity)
-  else
-    Canvas.Draw(X, Y, Bmp);
+  if not Bmp.Empty then begin
+    var X := R.Left;
+    var Y := R.Top;
+    if Center then begin
+      Inc(X, (R.Width - W) div 2);
+      if X < 0 then
+        X := 0;
+      Inc(Y, (R.Height - H) div 2);
+      if Y < 0 then
+        Y := 0;
+    end;
+
+    if not Is32bit and (ReplaceColor <> clNone) and (ReplaceWithColor <> clNone) then begin
+      Canvas.Brush.Color := ReplaceWithColor;
+      Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), ReplaceColor);
+    end else if Opacity <> 255 then
+      Canvas.Draw(X, Y, Bmp, Opacity)
+    else
+      Canvas.Draw(X, Y, Bmp);
+  end;
 
   if Assigned(OnPaint) then
     OnPaint(Sender, Canvas, R);

Components/FormBackgroundStyleHook.pas

@@ -0,0 +1,108 @@
+unit FormBackgroundStyleHook;
+
+{
+  Inno Setup
+  Copyright (C) 1997-2025 Jordan Russell
+  Portions by Martijn Laan
+  For conditions of distribution and use, see LICENSE.TXT.
+
+  Style hook for custom form backgrounds
+}
+
+interface
+
+uses
+  Vcl.Forms, Vcl.Controls, Vcl.Graphics {$IFDEF VCLSTYLES}, BitmapImage {$ENDIF};
+
+type
+  TFormBackgroundStyleHook = class(TFormStyleHook)
+{$IFDEF VCLSTYLES}
+  private
+    class constructor Create;
+    class destructor Destroy;
+    class var FBitmapImageImpl: TBitmapImageImplementation;
+    class var FBitmapImageImplInitialized: Boolean;
+    class var FGraphic: TGraphic;
+{$ENDIF}
+    class var FBackColor: TColor;
+    class var FCenter: Boolean;
+    class var FGraphicTarget: TControl;
+    class var FOpacity: Byte;
+    class var FStretch: Boolean;
+    class procedure SetGraphic(Value: TGraphic); static;
+{$IFDEF VCLSTYLES}
+  protected
+    procedure PaintBackground(Canvas: TCanvas); override;
+{$ENDIF}
+  public
+    class property BackColor: TColor write FBackColor;
+    class property Center: Boolean write FCenter;
+    class property Graphic: TGraphic write SetGraphic;
+    class property GraphicTarget: TControl write FGraphicTarget;
+    class property Opacity: Byte write FOpacity;
+    class property Stretch: Boolean write FStretch;
+  end;
+
+implementation
+
+{$IFDEF VCLSTYLES}
+
+uses
+  System.Classes, System.SysUtils;
+
+{ TFormBackgroundStyleHook }
+
+class constructor TFormBackgroundStyleHook.Create;
+begin
+  FBackColor := clNone;
+end;
+
+class destructor TFormBackgroundStyleHook.Destroy;
+begin
+  if FBitmapImageImplInitialized then
+    FBitmapImageImpl.DeInit;
+  FGraphic.Free;
+end;
+
+procedure TFormBackgroundStyleHook.PaintBackground(Canvas: TCanvas);
+begin
+  var R := Rect(0, 0, Control.ClientWidth, Control.ClientHeight);
+
+  if (FGraphicTarget = Control) and (FBitmapImageImplInitialized or (FGraphic <> nil)) then begin
+    if not FBitmapImageImplInitialized then begin
+      FBitmapImageImpl.Init(Control);
+      FBitmapImageImpl.SetGraphic(FGraphic);
+      FreeAndNil(FGraphic);
+      FBitmapImageImplInitialized := True;
+    end;
+    FBitmapImageImpl.BackColor := FBackColor;
+    FBitmapImageImpl.Center := FCenter;
+    FBitmapImageImpl.Opacity := FOpacity;
+    FBitmapImageImpl.Stretch := FStretch;
+    FBitmapImageImpl.Paint(Control, Canvas, R);
+  end else if (FBackColor <> clNone) and (FBackColor <> clWindow) then begin
+    Canvas.Brush.Color := TBitmapImageImplementation.AdjustColorForStyle(Control, FBackColor);
+    Canvas.FillRect(R);
+  end else
+    inherited;
+end;
+
+{$ENDIF}
+
+class procedure TFormBackgroundStyleHook.SetGraphic(Value: TGraphic);
+begin
+{$IFDEF VCLSTYLES}
+  if FBitmapImageImplInitialized then begin
+    FBitmapImageImpl.DeInit;
+    FBitmapImageImplInitialized := False;
+  end;
+  if FGraphic <> nil then
+    FreeAndNil(FGraphic);
+  if Value <> nil then begin
+    FGraphic := TGraphicClass(Value.ClassType).Create;
+    FGraphic.Assign(Value);
+  end;
+{$ENDIF}
+end;
+
+end.