innosetup/Components/FormBackgroundStyleHook.pas

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}, System.Classes, BitmapImage {$ENDIF};

type
{$IFDEF VCLSTYLES}
  TGraphicTargetNotifier = class(TComponent)
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  end;
{$ENDIF}

  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;
{$IFDEF VCLSTYLES}
    class var FGraphicTargetNotifier: TGraphicTargetNotifier;
{$ENDIF}
    class var FOpacity: Byte;
    class var FStretch: Boolean;
    class procedure SetGraphic(Value: TGraphic); static;
    class procedure SetGraphicTarget(Value: TControl); 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 SetGraphicTarget;
    class property Opacity: Byte write FOpacity;
    class property Stretch: Boolean write FStretch;
  end;

implementation

{$IFDEF VCLSTYLES}

uses
  System.SysUtils;

{ TGraphicTargetNotifier }

procedure TGraphicTargetNotifier.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = TFormBackgroundStyleHook.FGraphicTarget) then
    TFormBackgroundStyleHook.FGraphicTarget := nil;
end;

{ TFormBackgroundStyleHook }

class constructor TFormBackgroundStyleHook.Create;
begin
  FBackColor := clNone;
  FGraphicTargetNotifier := TGraphicTargetNotifier.Create(nil);
end;

class destructor TFormBackgroundStyleHook.Destroy;
begin
  if FBitmapImageImplInitialized then
    FBitmapImageImpl.DeInit;
  FGraphic.Free;
  FGraphicTargetNotifier.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;

class procedure TFormBackgroundStyleHook.SetGraphicTarget(Value: TControl);
begin
{$IFDEF VCLSTYLES}
  if FGraphicTarget <> nil then
    FGraphicTarget.RemoveFreeNotification(FGraphicTargetNotifier);
  FGraphicTarget := Value;
  if FGraphicTarget <> nil then
    FGraphicTarget.FreeNotification(FGraphicTargetNotifier);
{$ENDIF}
end;

end.