{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvBackgrounds.PAS, released on 2004-04-26.

The Initial Developer of the Original Code is Robert Rossmair [Robert dott Rossmair att t-online dott de]
Portions created by Robert Rossmair are Copyright (C) 2003 Robert Rossmair.
All Rights Reserved.

Contributors:
  Andreas Hausladen (ahuser)
  Peter Thornqvist (peter3)
  Robert Marquardt (marquardt)
  Robert Rossmair (rrossmair)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvBackgrounds.pas 11024 2006-11-22 18:35:16Z ahuser $

unit JvBackgrounds;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

{***************** Conditional Compiler Symbols ************************

 USEJVCL        JEDI VCL installed (http://sourceforge.net/projects/jvcl/)

 USE_JvGIF      use TGIFImage class from JVCL

 USE_AM_GIF     use GIFImage library by Anders Melander et alii
                (download address: http://finn.mobilixnet.dk/delphi/).

 NO_DESIGNHOOK  Disables visual feedback in design mode.
                $DEFINE this if you experience problems in design mode.
                Such problems might occur if there are other components
                manipulating the TrrBackgrounds.Client's window
                procedure.
 *********************************************************************** }

{$DEFINE USEJVCL}
{.$DEFINE USE_AM_GIF}
{.$DEFINE USE_JvGIF}

{$IFDEF USE_JvGIF}
{$UNDEF USE_AM_GIF}
{$ENDIF USE_JvGIF}

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, Contnrs, Graphics, Controls, Forms, Classes,
  JclGraphUtils,
  JvTypes;

type
  TJvBackgroundMode = (bmTile, bmCenter, bmTopLeft, bmTop, bmTopRight, bmLeft,
    bmBottomLeft, bmRight, bmBottom, bmBottomRight, bmStretch);
  EJvBackgroundError = class(EJVCLException);
  TJvBackgroundShiftMode = (smRows, smColumns);

  TJvBackgroundImage = class(TPersistent)
  private
    FPicture: TPicture;
    FCanvas: TCanvas;
    FHorzOffset: Integer;
    FVertOffset: Integer;
    FOnChange: TNotifyEvent;
    FWorkingBmp: TBitmap;
    FInUpdWorkingBmp: Boolean;
    FMode: TJvBackgroundMode;
    FTransparent: Boolean;
    FTransparentMode: TTransparentMode;
    FTransparentColor: TColor;
    FTileWidth: Integer;
    FTileHeight: Integer;
    FShift: Integer;
    FShiftMode: TJvBackgroundShiftMode;
    FZigZag: Boolean;
    FAutoSizeTile: Boolean;
    FFitPictureSize: Boolean;
    FEnabled: Boolean;
    FPictureValid: Boolean;
    FGrayMapped: Boolean;
    procedure SetGrayMapped(Value: Boolean);
    procedure SysColorChange;
    class function MainWindowHook(var Msg: TMessage): Boolean;
    procedure HookMainWindow;
    procedure UnhookMainWindow;
    procedure Changed;
    function GetTransparentColor: TColor;
    procedure PictureChanged(Sender: TObject);
    procedure SetAutoSizeTile(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetFitPictureSize(Value: Boolean);
    procedure SetMode(Value: TJvBackgroundMode);
    procedure SetPicture(Value: TPicture);
    procedure SetShift(Value: Integer);
    procedure SetShiftMode(Value: TJvBackgroundShiftMode);
    procedure SetTileWidth(Value: Integer);
    procedure SetTileHeight(Value: Integer);
    procedure SetTransparent(Value: Boolean);
    procedure SetTransparentColor(Value: TColor);
    procedure SetTransparentMode(Value: TTransparentMode);
    procedure SetZigZag(Value: Boolean);
    procedure TileGraphic(AClient: TControl; Graphic: TGraphic);
    function TransparentColorStored: Boolean;
    procedure UpdateWorkingBmp;
    procedure WorkingBmpNeeded;
  protected
    function HandleWMEraseBkgnd(AClient: TWinControl; var Msg: TMessage): Boolean;
    function HandleWMPaint(AClient: TWinControl; var Msg: TMessage): Boolean;
    procedure PaintGraphic(AClient: TControl; DC: HDC; Graphic: TGraphic);
    property Canvas: TCanvas read FCanvas;
    property WorkingBmp: TBitmap read FWorkingBmp;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DoEraseBackground(AClient: TWinControl; DC: HDC): Boolean;
  published
    property AutoSizeTile: Boolean read FAutoSizeTile write SetAutoSizeTile
      default True;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property FitPictureSize: Boolean
      read FFitPictureSize write SetFitPictureSize default False;
    property GrayMapped: Boolean read FGrayMapped write SetGrayMapped default False;
    property Mode: TJvBackgroundMode read FMode write SetMode default bmTile;
    property Picture: TPicture read FPicture write SetPicture;
    property TileWidth: Integer read FTileWidth write SetTileWidth;
    property TileHeight: Integer read FTileHeight write SetTileHeight;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property TransparentColor: TColor read GetTransparentColor
      write SetTransparentColor stored TransparentColorStored;
    property TransparentMode: TTransparentMode read FTransparentMode
      write SetTransparentMode default tmAuto;
    property Shift: Integer read FShift write SetShift default 0;
    property ShiftMode: TJvBackgroundShiftMode read FShiftMode write SetShiftMode default smRows;
    property ZigZag: Boolean read FZigZag write SetZigZag default False;
  end;

  TJvControlBackground = class(TJvBackgroundImage)
  private
    FClient: TWinControl;
  public
    function HookBeforeMessage(var Msg: TMessage): Boolean;
    procedure HookAfterMessage(var Msg: TMessage);
    constructor Create(AClient: TWinControl);
  end;

  TJvBackground = class;

  TJvBackgroundClientLink = class(TObject)
  private
    FBackground: TJvBackground;
    FClient: TWinControl;
    FNewWndProc: Pointer;
    FPrevWndProc: TFarProc;
    FClientIsMDIForm: Boolean;
    procedure ClientInvalidate;
    procedure MainWndProc(var Msg: TMessage);
    procedure ClientWndProc(var Message: TMessage);
    procedure ForceClient(Value: TWinControl; Force: Boolean = True);
    procedure HookClient;
    procedure UnhookClient;
    function GetClientColor: TColor;
    function GetClientHandle: THandle;
    procedure SetClient(Value: TWinControl);
  protected
    procedure Release;
    property Background: TJvBackground read FBackground;
    property ClientColor: TColor read GetClientColor;
    property ClientHandle: THandle read GetClientHandle;
    property Client: TWinControl read FClient write SetClient;
    property ClientIsMDIForm: Boolean read FClientIsMDIForm;
  public
    constructor Create(ABackground: TJvBackground; AClient: TWinControl);
    destructor Destroy; override;
  end;

  TJvBackgroundClients = class(TPersistent)
  private
    FBackground: TJvBackground;
    FLinks: TObjectList;
    FFixups: TStringList;
    function GetClient(Index: Integer): TWinControl;
    procedure Invalidate;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
    procedure FixupReferences(Root: TComponent);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    function GetLink(Index: Integer): TJvBackgroundClientLink;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    property Background: TJvBackground read FBackground;
    property Links[Index: Integer]: TJvBackgroundClientLink read GetLink;
  public
    constructor Create(ABackground: TJvBackground);
    destructor Destroy; override;
    procedure Clear;
    procedure Add(Control: TWinControl);
    procedure Remove(Control: TWinControl);
    function IndexOf(Control: TWinControl): Integer;
    property Clients[Index: Integer]: TWinControl read GetClient; default;
  end;

  TJvBackground = class(TComponent)
  private
    FClients: TJvBackgroundClients;
    FHandle: HWND;
    FImage: TJvBackgroundImage;
    procedure SetClients(Value: TJvBackgroundClients);
    procedure WallpaperChanged(Sender: TObject);
    procedure WndProc(var Msg: TMessage);
    procedure SetImage(const Value: TJvBackgroundImage);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function HasClient(Control: TWinControl): Boolean;
  published
    property Image: TJvBackgroundImage read FImage write SetImage;
    property Clients: TJvBackgroundClients read FClients write SetClients;
  end;

procedure GetMappedGrays(var Shades: array of TColor; StartIntensity: Byte);

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvBackgrounds.pas $';
    Revision: '$Revision: 11024 $';
    Date: '$Date: 2006-11-22 19:35:16 +0100 (mer., 22 nov. 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  SysUtils, jpeg,
  StdCtrls, CommCtrl, ComCtrls, Dialogs,
  {$IFDEF USE_AM_GIF}
  GIFImage,
  {$DEFINE HANDLES_GIF}
  {$ENDIF USE_AM_GIF}
  {$IFDEF USE_JvGIF}
  JvGIF,
  {$DEFINE HANDLES_GIF}
  {$ENDIF USE_JvGIF}
  JvJCLUtils, JvConsts, JvResources;

type
  TWinControlAccessProtected = class(TWinControl);

  {$IFDEF USE_JvGIF}
  // make TJvGIFImage's Bitmap property visible
  TGIFImage = class(TJvGIFImage);
  {$ENDIF USE_JvGIF}

const
  ScrollLineSize = 3;
  ScrollUnit = 8;

  CM_RECREATEWINDOW = CM_BASE + 82;
  CM_RELEASECLIENTLINK = CM_BASE + 83;

type
  TColorGradation = array [Byte] of TColor;
  PColorGradation = ^TColorGradation;

var
  SysColorGradation: TColorGradation;
  SysColorGradationInitialized: Boolean = False;
  Hooked: TList = nil;
  Backgrounds: TList = nil;

procedure UpdateSysColorGradation;
var
  SysHLS: THLSVector;
  FaceLum, MaxLum: THLSValue;
  I: Integer;
begin
  SysHLS := RGBtoHLS(ColorToRGB(clBtnHighlight));
  MaxLum := SysHLS.Luminance;
  SysHLS := RGBtoHLS(ColorToRGB(clBtnFace));
  FaceLum := SysHLS.Luminance;
  with SysHLS do
  begin
    for I := 0 to 192 do
    begin
      Luminance := I * FaceLum div 192;
      SysColorGradation[I] := HLStoRGB(Hue, Luminance, Saturation);
    end;
    for I := 193 to 255 do
    begin
      Luminance := FaceLum + (MaxLum - FaceLum) * (I - 192) div (255 - 192);
      SysColorGradation[I] := HLStoRGB(Hue, Luminance, Saturation);
    end;
  end;
end;

procedure SysColorsNeeded;
begin
  if not SysColorGradationInitialized then
  begin
    SysColorGradationInitialized := True;
    UpdateSysColorGradation;
  end;
end;

procedure GetMappedGrays(var Shades: array of TColor; StartIntensity: Byte);
var
  I, Intensity: Integer;
begin
  SysColorsNeeded;
  Intensity := StartIntensity;
  for I := Low(Shades) to High(Shades) do
  begin
    Shades[I] := SysColorGradation[Intensity];
    if Intensity < High(SysColorGradation) then
      Inc(Intensity);
  end;
end;

procedure MapGrays(Dest: TBitmap; Source: TGraphic);
var
  Grays: PColorGradation;
  I: Integer;
  SrcWasTransparent: Boolean;
begin
  if Source = nil then
    Exit;
  New(Grays);
  try
    for I := Low(Grays^) to High(Grays^) do
      Grays[I] := RGB(I, I, I);
    with Dest do
    begin
      if ((Source is TBitmap) and (TBitmap(Source).PixelFormat in [pf1bit..pf8bit]))
        {$IFDEF HANDLES_GIF} or (Source is TGIFImage) {$ENDIF} then
        Assign(Source)
      else
      begin
        PixelFormat := pf8bit;
        Width := Source.Width;
        Height := Source.Height;
        SetBitmapColors(Dest, Grays^, 0);
        SrcWasTransparent := Source.Transparent;
        try
          Source.Transparent := False;
          Canvas.Draw(0, 0, Source);
        finally
          Source.Transparent := SrcWasTransparent;
        end;
      end;
      Handle := CreateMappedBmp(Handle, Grays^, SysColorGradation);
    end;
  finally
    Dispose(Grays);
  end;
end;

function TrimmedOffset(Offset, TileDim: Integer): Integer;
begin
  if TileDim <> 0 then
    if Offset > 0 then
      Offset := (Offset mod TileDim) - TileDim
    else
    if Offset < 0 then
      Dec(Offset, (Offset div TileDim) * TileDim);
  Result := Offset;
end;

function GetClientRect(AClient: TControl): TRect;
var
  MDIClientHandle: HWND;
begin
  if AClient is TCustomForm then
  begin
    MDIClientHandle := TForm(AClient).ClientHandle;
    if MDIClientHandle <> 0 then
    begin
      Windows.GetClientRect(MDIClientHandle, Result);
      Exit;
    end;
  end;
  Result := AClient.ClientRect;
end;

function GetVirtualClientRect(AClient: TControl): TRect;
var
  ClientHandle: HWND;
  ScrollInfo: TScrollInfo;
  R: TRect;
  TVTopItem: TTreeNode;
begin
  Result := GetClientRect(AClient);
  if AClient is TWinControl then
  begin
    ClientHandle := TWinControl(AClient).Handle;
    FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
    ScrollInfo.cbSize := SizeOf(ScrollInfo);
    ScrollInfo.fMask := SIF_ALL;
    GetScrollInfo(ClientHandle, SB_HORZ, ScrollInfo);
    if ScrollInfo.nPage > 0 then // horizontal scroll bar visible
    begin
      if ScrollInfo.nMax > Result.Right then
        Result.Right := ScrollInfo.nMax;
      Dec(Result.Left, ScrollInfo.nPos);
      Dec(Result.Right, ScrollInfo.nPos);
    end;
    GetScrollInfo(ClientHandle, SB_VERT, ScrollInfo);
    if ScrollInfo.nPage > 0 then // vertical scroll bar visible
    begin
      if AClient is TCustomListBox then
        with TListBox(AClient) do
        begin
          ScrollInfo.nPos := ScrollInfo.nPos * ItemHeight;
          ScrollInfo.nMax := ScrollInfo.nMax * ItemHeight;
        end
      else
      if AClient is TCustomTreeView then
      begin
        TVTopItem := TCustomTreeView(AClient).TopItem;
        if Assigned(TVTopItem) and TreeView_GetItemRect(ClientHandle, TVTopItem.ItemID, R, False) then
        begin
          ScrollInfo.nPos := ScrollInfo.nPos * R.Bottom;
          ScrollInfo.nMax := ScrollInfo.nMax * R.Bottom;
        end;
      end;
      if ScrollInfo.nMax > Result.Bottom then
        Result.Bottom := ScrollInfo.nMax;
      Dec(Result.Top, ScrollInfo.nPos);
      Dec(Result.Bottom, ScrollInfo.nPos);
    end;
  end;
end;

function GetClientBrush(AClient: TControl): TBrush;
begin
  if AClient is TWinControl then
    Result := TWinControl(AClient).Brush
  else
    Result := AClient.Parent.Brush;
end;

function IsMDIForm(Control: TControl): Boolean;
begin
  Result := False;
  if Assigned(Control) then
    if Control is TCustomForm then
      Result := TForm(Control).FormStyle = fsMDIForm;
end;

//=== { TJvBackgroundImage } =================================================

constructor TJvBackgroundImage.Create;
begin
  inherited Create;
  FCanvas := TCanvas.Create;
  FAutoSizeTile := True;
  FEnabled := True;
  FTransparentColor := clDefault;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  HookMainWindow;
end;

destructor TJvBackgroundImage.Destroy;
begin
  UnhookMainWindow;
  FPicture.Free;
  FWorkingBmp.Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TJvBackgroundImage.Assign(Source: TPersistent);
var
  Src: TJvBackgroundImage;
begin
  if Source is TJvBackgroundImage then
  begin
    Src := TJvBackgroundImage(Source);
    AutoSizeTile := Src.AutoSizeTile;
    Enabled := Src.Enabled;
    FitPictureSize := Src.FitPictureSize;
    GrayMapped := Src.GrayMapped;
    Mode := Src.Mode;
    Picture := Src.Picture;
    TileWidth := Src.TileWidth;
    TileHeight := Src.TileHeight;
    Transparent := Src.Transparent;
    TransparentColor := Src.TransparentColor;
    TransparentMode := Src.TransparentMode;
    Shift := Src.Shift;
    ShiftMode := Src.ShiftMode;
    ZigZag := Src.ZigZag;
  end
  else
    inherited Assign(Source);
end;

procedure TJvBackgroundImage.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TJvBackgroundImage.HandleWMEraseBkgnd(AClient: TWinControl; var Msg: TMessage): Boolean;
begin
  Result := FEnabled and FPictureValid;
  if Result then
  begin
    if not IsIconic(AClient.Handle) then
      if not TWinControlAccessProtected(AClient).FDoubleBuffered or (Msg.wParam = Msg.lParam) then
        DoEraseBackground(AClient,
          TWMEraseBkgnd(Msg).DC);
    Msg.Result := 1;
  end;
end;

function TJvBackgroundImage.HandleWMPaint(AClient: TWinControl; var Msg: TMessage): Boolean;
var
  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
  ClientRect: TRect;
begin
  Result := False;
  if FEnabled and FPictureValid then
    if TWinControlAccessProtected(AClient).FDoubleBuffered and (TWMPaint(Msg).DC = 0) then
    begin
      DC := GetDC(HWND_DESKTOP);
      ClientRect := AClient.ClientRect;
      MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
      ReleaseDC(HWND_DESKTOP, DC);
      MemDC := CreateScreenCompatibleDC;
      OldBitmap := SelectObject(MemDC, MemBitmap);
      try
        DC := BeginPaint(AClient.Handle, PS);
        DoEraseBackground(AClient, MemDC);
        Msg.Result := AClient.Perform(WM_PAINT, MemDC, 0);
        BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
        EndPaint(AClient.Handle, PS);
      finally
        SelectObject(MemDC, OldBitmap);
        DeleteDC(MemDC);
        DeleteObject(MemBitmap);
      end;
      Result := True;
    end;
end;

procedure TJvBackgroundImage.TileGraphic(AClient: TControl; Graphic: TGraphic);
var
  I, J: Integer;
  iMin: Integer;
  FirstVisibleRow, S, OddShift: Integer;
  Left, Top, Width, Height: Integer;
  HorzOffset, VertOffset: Integer;
begin
  with GetClientRect(AClient) do
  begin
    Width := Right;
    Height := Bottom;
  end;
  if IsMDIForm(AClient) then
  begin
    HorzOffset := FHorzOffset;
    VertOffset := FVertOffset;
  end
  else
    with GetVirtualClientRect(AClient) do
    begin
      HorzOffset := Left;
      VertOffset := Top;
    end;
  if FShiftMode = smRows then
  begin
    FirstVisibleRow := -VertOffset div FTileHeight;
    if VertOffset > 0 then
      Dec(FirstVisibleRow);
  end
  else
  begin
    FirstVisibleRow := -HorzOffset div FTileWidth;
    if HorzOffset > 0 then
      Dec(FirstVisibleRow);
  end;
  Left := TrimmedOffset(HorzOffset, FTileWidth);
  Top := TrimmedOffset(VertOffset, FTileHeight);
  Dec(Width, Left);
  Dec(Height, Top);

  OddShift := 0; // just to satisfy the compiler
  if FShiftMode = smRows then
  begin
    if FZigZag then
    begin
      OddShift := FTileWidth div 2;
      if Odd(FirstVisibleRow) then
        S := OddShift
      else
        S := 0;
    end
    else
    begin
      S := (FirstVisibleRow * FShift) mod FTileWidth;
      if S < 0 then
        Inc(S, FTileWidth);
    end;
    for J := 0 to (Height - 1) div FTileHeight do
    begin
      if S = 0 then
        iMin := 0
      else
        iMin := -1;
      for I := iMin to (Width - 1) div FTileWidth do
        Canvas.Draw(Left + I * FTileWidth + S, Top + J * FTileHeight, Graphic);
      if FZigZag then
        S := S xor OddShift
      else
      begin
        Inc(S, FShift);
        S := S mod FTileWidth;
      end;
    end;
  end
  else
  begin
    if FZigZag then
    begin
      OddShift := FTileHeight div 2;
      if Odd(FirstVisibleRow) then
        S := OddShift
      else
        S := 0;
    end
    else
    begin
      S := (FirstVisibleRow * FShift) mod FTileHeight;
      if S < 0 then
        Inc(S, FTileHeight);
    end;
    for I := 0 to (Width - 1) div FTileWidth do
    begin
      if S = 0 then
        iMin := 0
      else
        iMin := -1;
      for J := iMin to (Height - 1) div FTileHeight do
        Canvas.Draw(Left + I * FTileWidth, Top + J * FTileHeight + S, Graphic);
      if FZigZag then
        S := S xor OddShift
      else
      begin
        Inc(S, FShift);
        S := S mod FTileHeight;
      end;
    end;
  end;
end;

procedure TJvBackgroundImage.PaintGraphic(AClient: TControl; DC: HDC; Graphic: TGraphic);
var
  R, Rg: TRect;
  X, Y, W, H: Integer;
  SaveIndex: Integer;
  WindowStyle: DWORD;
  GraphW, GraphH: Integer;
  Factor, FactorVert: Single;
begin
  SaveIndex := SaveDC(DC);
  with Canvas do
  begin
    Handle := DC;
    if FMode = bmTile then
      TileGraphic(AClient, Graphic)
    else
    begin
      if IsMDIForm(AClient) then
      begin
        R := GetClientRect(AClient);
        // We don't want the background move
        // when scrollbars appear or disappear:
        WindowStyle := GetWindowLong(TForm(AClient).ClientHandle, GWL_STYLE);
        if (WindowStyle and WS_HSCROLL) <> 0 then
          Inc(R.Bottom, GetSystemMetrics(SM_CYHSCROLL));
        if (WindowStyle and WS_VSCROLL) <> 0 then
          Inc(R.Right, GetSystemMetrics(SM_CXVSCROLL));
      end
      else
        R := GetVirtualClientRect(AClient);
      W := R.Right - R.Left;
      H := R.Bottom - R.Top;
      GraphW := Graphic.Width;
      GraphH := Graphic.Height;
      if FFitPictureSize and not (FMode = bmStretch) then
      begin
        Factor := W / GraphW;
        FactorVert := H / GraphH;
        if FactorVert < Factor then
          Factor := FactorVert;
        GraphW := Round(Factor * GraphW);
        GraphH := Round(Factor * GraphH);
      end;
      Rg := Rect(0, 0, GraphW, GraphH);
      Brush := GetClientBrush(AClient);
      case FMode of
        bmCenter:
          begin
            X := R.Left + (W - GraphW) div 2;
            Y := R.Top + (H - GraphH) div 2;
            FillRect(Rect(R.Left, R.Top, R.Right, Y));
            FillRect(Rect(R.Left, Y, X, Y + GraphH));
            FillRect(Rect(X + GraphW, Y, R.Right, Y + GraphH));
            FillRect(Rect(R.Left, Y + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, X, Y);
          end;
        bmStretch:
          Rg := R;
        bmTopLeft:
          begin
            FillRect(Rect(R.Left + GraphW, R.Top, R.Right, R.Top + GraphH));
            FillRect(Rect(R.Left, R.Top + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, R.Left, R.Top);
          end;
        bmTopRight:
          begin
            FillRect(Rect(R.Left, R.Top, R.Right - GraphW, R.Top + GraphH));
            FillRect(Rect(R.Left, R.Top + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, R.Right - GraphW, R.Top);
          end;
        bmBottomLeft:
          begin
            FillRect(Rect(R.Left, R.Top, R.Right, R.Bottom - GraphH));
            FillRect(Rect(R.Left + GraphW, R.Bottom - GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, R.Left, R.Bottom - GraphH);
          end;
        bmBottomRight:
          begin
            FillRect(Rect(R.Left, R.Top, R.Right, R.Bottom - GraphH));
            FillRect(Rect(R.Left, R.Bottom - GraphH, R.Right - GraphW, R.Bottom));
            OffsetRect(Rg, R.Right - GraphW, R.Bottom - GraphH);
          end;
        bmTop:
          begin
            X := R.Left + (W - GraphW) div 2;
            FillRect(Rect(R.Left, R.Top, X, GraphH));
            FillRect(Rect(X + GraphW, R.Top, R.Right, GraphH));
            FillRect(Rect(R.Left, R.Top + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, X, R.Top);
          end;
        bmLeft:
          begin
            Y := R.Top + (H - GraphH) div 2;
            FillRect(Rect(R.Left, R.Top, R.Right, Y));
            FillRect(Rect(R.Left + GraphW, Y, R.Right, Y + GraphH));
            FillRect(Rect(R.Left, Y + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, R.Left, Y);
          end;
        bmBottom:
          begin
            X := R.Left + (W - GraphW) div 2;
            Y := R.Bottom - GraphH;
            FillRect(Rect(R.Left, R.Top, R.Right, Y));
            FillRect(Rect(R.Left, Y, X, R.Bottom));
            FillRect(Rect(X + GraphW, Y, R.Right, R.Bottom));
            OffsetRect(Rg, X, Y);
          end;
        bmRight:
          begin
            X := R.Right - GraphW;
            Y := R.Top + (H - GraphH) div 2;
            FillRect(Rect(R.Left, R.Top, R.Right, Y));
            FillRect(Rect(R.Left, Y, X, Y + GraphH));
            FillRect(Rect(R.Left, Y + GraphH, R.Right, R.Bottom));
            OffsetRect(Rg, X, Y);
          end;
      end;
      StretchDraw(Rg, Graphic);
    end;
    Handle := 0;
  end;
  RestoreDC(DC, SaveIndex);
end;

function TJvBackgroundImage.DoEraseBackground(AClient: TWinControl; DC: HDC): Boolean;
var
  Graphic: TGraphic;
  Bmp: TBitmap;
begin
  Result := FPictureValid and AClient.HandleAllocated;
  if Result then
  begin
    Bmp := nil;
    try
      Graphic := FWorkingBmp;
      if Graphic = nil then
        Graphic := FPicture.Graphic
      else
      if Transparent then
      begin
        Bmp := TBitmap.Create;
        Bmp.Assign(Graphic);
        Bmp.Canvas.Brush := GetClientBrush(AClient);
        Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
        Bmp.Canvas.Draw(0, 0, Graphic);
        Bmp.Transparent := False;
        Graphic := Bmp;
      end;
      PaintGraphic(AClient, DC, Graphic);
    finally
      Bmp.Free;
    end;
  end;
end;

function TJvBackgroundImage.GetTransparentColor: TColor;
var
  Bmp: TBitmap;
begin
  Bmp := nil;
  if FTransparentColor = clDefault then
    {$IFDEF HANDLES_GIF}
    if FPicture.Graphic is TGIFImage then
      Bmp := TGIFImage(FPicture.Graphic).Bitmap
    else
    {$ENDIF HANDLES_GIF}
    if FPicture.Graphic is TBitmap then
      Bmp := TBitmap(FPicture.Graphic);
  if Assigned(Bmp) then
  begin
    if Bmp.Monochrome then
      Result := clWhite
    else
      Result := Bmp.Canvas.Pixels[0, Bmp.Height - 1];
  end
  else
    Result := ColorToRGB(FTransparentColor);
  Result := Result or $02000000;
end;

procedure TJvBackgroundImage.PictureChanged(Sender: TObject);
begin
  if FInUpdWorkingBmp then
    Exit;
  FPictureValid := (FPicture.Width > 0) and (FPicture.Height > 0);
  if (FTileWidth < Picture.Width) or (FTileHeight < Picture.Height) or (AutoSizeTile and FPictureValid) then
  begin
    FTileWidth := Picture.Width;
    FTileHeight := Picture.Height;
  end;
  with Picture do
    if Graphic <> nil then
      Graphic.Transparent := FTransparent;
  UpdateWorkingBmp;
end;

procedure TJvBackgroundImage.SetAutoSizeTile(Value: Boolean);
begin
  if FAutoSizeTile <> Value then
  begin
    FAutoSizeTile := Value;
    if Mode = bmTile then
      if (TileWidth <> Picture.Width) or (TileHeight <> Picture.Height) then
        PictureChanged(Self);
  end;
end;

procedure TJvBackgroundImage.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    Changed;
  end;
end;

procedure TJvBackgroundImage.SetFitPictureSize(Value: Boolean);
begin
  if FFitPictureSize <> Value then
  begin
    FFitPictureSize := Value;
    if not (FMode in [bmTile, bmStretch]) then
      Changed;
  end;
end;

procedure TJvBackgroundImage.SetMode(Value: TJvBackgroundMode);
var
  TileModeChanged: Boolean;
begin
  if Value <> FMode then
  begin
    TileModeChanged := (FMode = bmTile) or (Value = bmTile);
    FMode := Value;
    if TileModeChanged and ((FTileWidth <> Picture.Width) or (FTileHeight <> Picture.Height)) then
      PictureChanged(Self)
    else
      Changed;
  end;
end;

procedure TJvBackgroundImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TJvBackgroundImage.SetShift(Value: Integer);
begin
  if Value <> FShift then
  begin
    FShift := Value;
    FZigZag := False;
    if FMode = bmTile then
      Changed;
  end;
end;

procedure TJvBackgroundImage.SetShiftMode(Value: TJvBackgroundShiftMode);
begin
  if FShiftMode <> Value then
  begin
    FShiftMode := Value;
    if FMode = bmTile then
      Changed;
  end;
end;

procedure TJvBackgroundImage.SetTileWidth(Value: Integer);
begin
  if AutoSizeTile then
    Exit;
  if Value < Picture.Width then
    Value := Picture.Width;
  if Value <> FTileWidth then
  begin
    FTileWidth := Value;
    if Mode = bmTile then
      PictureChanged(Self);
  end;
end;

procedure TJvBackgroundImage.SetTileHeight(Value: Integer);
begin
  if AutoSizeTile then
    Exit;
  if Value < Picture.Height then
    Value := Picture.Height;
  if Value <> FTileHeight then
  begin
    FTileHeight := Value;
    if Mode = bmTile then
      PictureChanged(Self);
  end;
end;

procedure TJvBackgroundImage.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    PictureChanged(Self);
  end;
end;

procedure TJvBackgroundImage.SetTransparentColor(Value: TColor);
begin
  if Value <> FTransparentColor then
  begin
    if Value = clDefault then
      FTransparentMode := tmAuto
    else
      FTransparentMode := tmFixed;
    FTransparentColor := Value;
    if Transparent then
      UpdateWorkingBmp;
  end;
end;

procedure TJvBackgroundImage.SetTransparentMode(Value: TTransparentMode);
begin
  if Value <> FTransparentMode then
  begin
    if Value = tmAuto then
      SetTransparentColor(clDefault)
    else
      SetTransparentColor(GetTransparentColor);
  end;
end;

procedure TJvBackgroundImage.SetZigZag(Value: Boolean);
begin
  if Value <> FZigZag then
  begin
    FZigZag := Value;
    if FMode = bmTile then
      Changed;
  end;
end;

function TJvBackgroundImage.TransparentColorStored: Boolean;
begin
  Result := FTransparentMode = tmFixed;
end;

{
  TJvBackgroundImage.UpdateWorkingBmp
  Transparency: all except TJPEGImage
  GrayMapping: all except TIcon, TMetafile
}

procedure TJvBackgroundImage.UpdateWorkingBmp;
var
  X, Y: Integer;
  IsBitmap: Boolean;
  Bmp: TBitmap;
  MaskBmp: TBitmap;
  {$IFNDEF NO_JPEG}
  GrayscaleState: Boolean;
  {$ENDIF !NO_JPEG}
  {$IFNDEF NO_JPEG}
  IsJPEG: Boolean;
  {$ENDIF !NO_JPEG}
  IsTransparent: Boolean;
  IsTranspGraphic: Boolean;
  IsIcon: Boolean;
  SizeTailored: Boolean;

  procedure DrawGraphic(Graphic: TGraphic);
  begin
    with FWorkingBmp.Canvas do
    begin
      Brush.Color := TransparentColor;
      FillRect(Rect(0, 0, FTileWidth, FTileHeight));
      Draw(X, Y, Graphic);
    end;
  end;

  function CreateTransparentBmp(Graphic: TGraphic): TBitmap;
  var
    W, H: Integer;
  begin
    Result := TBitmap.Create;
    if IsBitmap then
      Result.Assign(Graphic)
    else
    begin
      W := Graphic.Width;
      H := Graphic.Height;
      Result.Width := W;
      Result.Height := H;
      with Result.Canvas do
      begin
        Brush.Color := TransparentColor;
        FillRect(Rect(0, 0, W, H));
        Draw(0, 0, Graphic);
      end;
    end;
  end;

begin
  if FInUpdWorkingBmp then
    Exit;
  with FPicture do
    if Graphic <> nil then
    try
      FInUpdWorkingBmp := True;
      SizeTailored := False;
      X := 0;
      Y := 0;
      if FMode = bmTile then
      begin
        X := FTileWidth - Graphic.Width;
        Y := FTileHeight - Graphic.Height;
        SizeTailored := (X <> 0) or (Y <> 0);
        X := X div 2;
        Y := Y div 2;
      end;
      IsBitmap := (Graphic is TBitmap)
        // GIF goes as bitmap here
        {$IFDEF HANDLES_GIF} or (Graphic is TGIFImage) {$ENDIF};
      IsIcon := Graphic is TIcon;
      IsTranspGraphic := IsIcon or (Graphic is TMetafile);
      // if Graphic is transparent
      {$IFDEF NO_JPEG}
      IsTransparent := Transparent or IsTranspGraphic;
      {$ELSE}
      IsJPEG := Graphic is TJPEGImage;
      IsTransparent := (Transparent and not IsJPEG) or IsTranspGraphic;
      {$ENDIF NO_JPEG}
      if IsTransparent or FGrayMapped or SizeTailored then
      begin
        WorkingBmpNeeded;
        if IsTranspGraphic then
          with FWorkingBmp.Canvas do
          begin
            Brush.Color := TransparentColor;
            FillRect(Rect(0, 0, FTileWidth, FTileHeight));
            Draw(X, Y, Graphic);
          end
        else
        if IsTransparent then // and not IsTranspGraphic
        begin
          Bmp := CreateTransparentBmp(Graphic);
          try
            with TImageList.CreateSize(Graphic.Width, Graphic.Height) do
            try
              if FGrayMapped then
              begin
                MaskBmp := TBitmap.Create;
                with MaskBmp do
                try
                  Assign(Bmp);
                  Mask(GetTransparentColor);
                  MapGrays(Bmp, FPicture.Graphic);
                  Add(Bmp, MaskBmp);
                finally
                  Free;
                end;
              end
              else
                AddMasked(Bmp, GetTransparentColor);
              FWorkingBmp.HandleType := bmDDB; // otherwise eventually background color won't appear correctly
              with FWorkingBmp.Canvas do
              begin
                Brush.Color := TransparentColor;
                FillRect(Rect(0, 0, FTileWidth, FTileHeight));
              end;
              BkColor := ColorToRGB(TransparentColor);
              Draw(FWorkingBmp.Canvas, X, Y, 0);
            finally
              Free;
            end
          finally
            Bmp.Free;
          end
        end
        else
        if GrayMapped then // and not Transparent
        begin
          Bmp := TBitmap.Create;
          try
            {$IFNDEF NO_JPEG}
            if IsJPEG then
              with TJPEGImage(Graphic) do
              begin
                GrayscaleState := Grayscale;
                try
                  Grayscale := True;
                  Bmp.Assign(Graphic);
                finally
                  Grayscale := GrayscaleState;
                end;
              end;
            {$ENDIF !NO_JPEG}
            MapGrays(Bmp, FPicture.Graphic);
            DrawGraphic(Bmp);
          finally
            Bmp.Free;
          end
        end
        else // if SizeTailored
          DrawGraphic(Picture.Graphic);
        WorkingBmp.Transparent := Transparent;
        WorkingBmp.TransparentColor := TransparentColor;
        Changed;
        Exit;
      end;
    finally
      FInUpdWorkingBmp := False;
    end;
  FWorkingBmp.Free;
  FWorkingBmp := nil;
  Changed;
end;

procedure TJvBackgroundImage.WorkingBmpNeeded;
var
  W, H: Integer;
begin
  if FWorkingBmp = nil then
    FWorkingBmp := TBitmap.Create;
  if FMode = bmTile then
  begin
    W := FTileWidth;
    H := FTileHeight;
  end
  else
  begin
    W := FPicture.Graphic.Width;
    H := FPicture.Graphic.Height;
  end;
  FWorkingBmp.Width := W;
  FWorkingBmp.Height := H;
end;

class function TJvBackgroundImage.MainWindowHook(var Msg: TMessage): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Msg.Msg = WM_SYSCOLORCHANGE then
  begin
    UpdateSysColorGradation;
    for I := 0 to Hooked.Count - 1 do
      TJvBackgroundImage(Hooked[I]).SysColorChange;
  end;
end;

procedure TJvBackgroundImage.HookMainWindow;
begin
  if Hooked = nil then
  begin
    Hooked := TList.Create;
    Application.HookMainWindow(MainWindowHook);
  end;
  if Hooked.IndexOf(Self) = -1 then
    Hooked.Add(Self);
end;

procedure TJvBackgroundImage.UnhookMainWindow;
begin
  Hooked.Remove(Self);
  if Hooked.Count = 0 then
  begin
    Application.UnhookMainWindow(MainWindowHook);
    Hooked.Free;
    Hooked := nil;
  end;
end;

procedure TJvBackgroundImage.SysColorChange;
begin
  if FGrayMapped then
    UpdateWorkingBmp;
end;

procedure TJvBackgroundImage.SetGrayMapped(Value: Boolean);
begin
  if Value <> FGrayMapped then
  begin
    if Value then
      SysColorsNeeded;
    FGrayMapped := Value;
    UpdateWorkingBmp;
  end;
end;

//=== { TJvControlBackground } ===============================================

constructor TJvControlBackground.Create(AClient: TWinControl);
begin
  inherited Create;
  FClient := AClient;
end;

function TJvControlBackground.HookBeforeMessage(var Msg: TMessage): Boolean;
begin
  Result := False;
  if FEnabled then
    case Msg.Msg of
      WM_PAINT:
        Result := HandleWMPaint(FClient, Msg);
      WM_ERASEBKGND:
        Result := HandleWMEraseBkgnd(FClient, Msg);
    end;
end;

procedure TJvControlBackground.HookAfterMessage(var Msg: TMessage);
begin
  if FEnabled then
    case Msg.Msg of
      WM_SIZE:
        if not (FMode in [bmTile, bmTopLeft]) then
          FClient.Invalidate;
      WM_HSCROLL:
        if FMode <> bmTile then
          FClient.Invalidate;
      WM_VSCROLL:
        if FMode <> bmTile then
          FClient.Invalidate;
    end;
end;

//=== { TJvBackgroundClientLink } ============================================

constructor TJvBackgroundClientLink.Create(ABackground: TJvBackground;
  AClient: TWinControl);
begin
  inherited Create;
  FBackground := ABackground;
  FNewWndProc := MakeObjectInstance(MainWndProc);
  ForceClient(AClient);
  ClientInvalidate;
end;

destructor TJvBackgroundClientLink.Destroy;
begin
  UnhookClient;
  if Assigned(FNewWndProc) then
    FreeObjectInstance(FNewWndProc);
  inherited Destroy;
end;

procedure TJvBackgroundClientLink.ClientInvalidate;
begin
  if not (csReading in FBackground.ComponentState) and not (csDestroying in FClient.ComponentState) then
    InvalidateRect(ClientHandle, nil, True);
end;

function GetMDIClientScrollDelta(ClientHandle: HWND; ScrollBar: Integer;
  const Msg: TWMScroll): Integer;
var
  ScrollInfo: TScrollInfo;
  Delta, MaxChange: Integer;
begin
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_ALL;
  GetScrollInfo(ClientHandle, ScrollBar, ScrollInfo);
  Delta := 0;
  case Msg.ScrollCode of
    SB_LINELEFT:
      begin
        Delta := ScrollInfo.nPos - ScrollInfo.nMin;
        if Delta > ScrollLineSize then
          Delta := ScrollLineSize;
      end;
    SB_LINERIGHT:
      with ScrollInfo do
      begin
        Delta := nPage - 1;
        if Delta < 0 then
          Delta := 0;
        Delta := nPos - (nMax - Delta);
        if Delta < -ScrollLineSize then
          Delta := -ScrollLineSize;
      end;
    SB_PAGELEFT:
      with ScrollInfo do
      begin
        Delta := nPage - 1;
        if Delta < 0 then
          Delta := 0;
        if Delta > nPos - nMin then
          Delta := nPos - nMin;
      end;
    SB_PAGERIGHT:
      with ScrollInfo do
      begin
        Delta := nPage - 1;
        if Delta < 0 then
          Delta := 0;
        MaxChange := (nMax - Delta) - nPos;
        if Delta > MaxChange then
          Delta := MaxChange;
        Delta := -Delta;
      end;
    SB_THUMBPOSITION:
      Delta := -Msg.Pos;
  end;
  Result := Delta * ScrollUnit;
end;

procedure TJvBackgroundClientLink.ClientWndProc(var Message: TMessage);

  procedure InvalidateBackground;
  begin
    InvalidateRect(ClientHandle, nil, True);
  end;

begin
  if ClientHandle <> 0 then
    with FBackground.FImage, Message do
    begin
      if ClientIsMDIForm then
      begin
        if Msg = WM_ERASEBKGND then
          if FEnabled and DoEraseBackground(FClient, TWMEraseBkgnd(Message).DC) then
          begin
            Result := 1;
            Exit;
          end;
      end
      else // not ClientIsMDIForm
      begin
        if FEnabled then
          case Msg of
            WM_PAINT:
              if HandleWMPaint(FClient, Message) then
                Exit;
            WM_ERASEBKGND:
              if HandleWMEraseBkgnd(FClient, Message) then
                Exit;
          end;
        Result := CallWindowProc(FPrevWndProc, ClientHandle, Msg, wParam, lParam);
        if Msg = CM_RELEASE then
          Exit;
      end;
      case Msg of
        WM_DESTROY:
          begin
            UnhookClient;
            if not (csDestroying in FClient.ComponentState) then
              PostMessage(FBackground.FHandle, CM_RECREATEWINDOW, 0, Longint(Self));
          end;
        WM_SIZE:
          if not (FMode in [bmTile, bmTopLeft]) then
            InvalidateBackground;
        WM_HSCROLL:
          begin
            if ClientIsMDIForm then
              Inc(FHorzOffset, GetMDIClientScrollDelta(ClientHandle,
                SB_HORZ, TWMScroll(Message)));
            if FMode <> bmTile then
              InvalidateBackground;
          end;
        WM_VSCROLL:
          begin
            if ClientIsMDIForm then
              Inc(FVertOffset, GetMDIClientScrollDelta(ClientHandle,
                SB_VERT, TWMScroll(Message)));
            if FMode <> bmTile then
              InvalidateBackground;
          end;
      end;
      if ClientIsMDIForm then
        Result := CallWindowProc(FPrevWndProc, ClientHandle, Msg, wParam, lParam);
    end;
end;

procedure TJvBackgroundClientLink.MainWndProc(var Msg: TMessage);
begin
  try
    try
      ClientWndProc(Msg);
    finally
      //FreeDeviceContexts;
      FreeMemoryContexts;
    end;
  except
    Application.HandleException(Self);
  end;
end;

procedure TJvBackgroundClientLink.ForceClient(Value: TWinControl; Force: Boolean = True);
var
  I: Integer;
  Bk: TJvBackground;
begin
  if Value <> FClient then
  begin
    for I := 0 to Backgrounds.Count - 1 do
    begin
      Bk := Backgrounds[I];
      if (Bk <> FBackground) and Bk.HasClient(Value) then
        if Force then
        begin
          Bk.Clients.Remove(Value);
          Break;
        end
        else
          Exit;
    end;
    UnhookClient;
    if Assigned(FClient) then
      FBackground.RemoveFreeNotification(FClient);
    FClient := Value;
    if Assigned(Value) then
    begin
      FClientIsMDIForm := IsMDIForm(Value);
      FBackground.FreeNotification(Value);
      if not (csLoading in FBackground.ComponentState) then
        HookClient;
    end;
  end;
end;

procedure TJvBackgroundClientLink.HookClient;
begin
  {$IFDEF NO_DESIGNHOOK}
  if csDesigning in ComponentState then
    Exit;
  {$ENDIF NO_DESIGNHOOK}
  if Assigned(FClient) and not Assigned(FPrevWndProc) then
    if not ((csLoading in FClient.ComponentState) or ((FClient is TCustomForm) and (csDesigning in FClient.ComponentState))) then
    begin
      FClient.HandleNeeded;
      FPrevWndProc := Pointer(SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FNewWndProc)));
      FBackground.FImage.UpdateWorkingBmp;
    end;
end;

procedure TJvBackgroundClientLink.UnhookClient;
const
  WorkaroundStr: array [Boolean] of string = ('', SWorkaround);
begin
  if Assigned(FPrevWndProc) then
    if Assigned(FClient) then
    begin
      if FClient.HandleAllocated then
      begin
        if (Longint(FNewWndProc) <>
          SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FPrevWndProc))) and
          not (csDestroying in FClient.ComponentState) then
          MessageDlg(Format(SChainError, [FBackground.Owner.Name, FBackground.Name, FClient.Name,
            WorkaroundStr[csDesigning in FBackground.ComponentState]]),
              mtWarning, [mbOK], 0);
      end;
      FPrevWndProc := nil;
      ClientInvalidate;
      FClientIsMDIForm := False;
    end;
end;

function TJvBackgroundClientLink.GetClientColor: TColor;
begin
  Result := TWinControlAccessProtected(FClient).Color;
end;

function TJvBackgroundClientLink.GetClientHandle: THandle;
begin
  Result := 0;
  if FClient is TCustomForm then
    Result := TForm(FClient).ClientHandle;
  if Result = 0 then
    if FClient.HandleAllocated then
      Result := FClient.Handle;
end;

procedure TJvBackgroundClientLink.SetClient(Value: TWinControl);
begin
  ForceClient(Value);
end;

procedure TJvBackgroundClientLink.Release;
begin
  UnhookClient;
  PostMessage(FBackground.FHandle, CM_RELEASECLIENTLINK, 0, Longint(Self));
end;

//=== { TJvBackgroundClients } ===============================================

constructor TJvBackgroundClients.Create(ABackground: TJvBackground);
begin
  inherited Create;
  FBackground := ABackground;
  FLinks := TObjectList.Create;
  FLinks.OwnsObjects := False;
  FFixups := TStringList.Create;
end;

destructor TJvBackgroundClients.Destroy;
begin
  FFixups.Free;
  Clear; // release links
  FLinks.Free;
  inherited Destroy;
end;

procedure TJvBackgroundClients.Clear;
var
  I: Integer;
begin
  for I := 0 to FLinks.Count - 1 do
    Links[I].Release;
  FLinks.Clear;
end;

procedure TJvBackgroundClients.Add(Control: TWinControl);
begin
  if IndexOf(Control) < 0 then
    FLinks.Add(TJvBackgroundClientLink.Create(FBackground, Control));
end;

procedure TJvBackgroundClients.Remove(Control: TWinControl);
var
  I: Integer;
  Link: TJvBackgroundClientLink;
begin
  I := IndexOf(Control);
  if I >= 0 then
  begin
    Link := TJvBackgroundClientLink(Links[I]);
    FLinks.Delete(I);
    Link.Release;
  end;
end;

function TJvBackgroundClients.GetClient(Index: Integer): TWinControl;
begin
  Result := TJvBackgroundClientLink(FLinks[Index]).Client;
end;

function TJvBackgroundClients.IndexOf(Control: TWinControl): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FLinks.Count - 1 do
    if Links[I].Client = Control then
    begin
      Result := I;
      Exit;
    end;
end;

procedure TJvBackgroundClients.Notification(AComponent: TComponent; Operation: TOperation);
var
  I: Integer;
  Client: TWinControl;
begin
  if Operation = opRemove then
    for I := 0 to FLinks.Count - 1 do
    begin
      Client := Links[I].Client;
      if AComponent = Client then
        Remove(Client);
    end;
end;

procedure TJvBackgroundClients.DefineProperties(Filer: TFiler);

  function WriteClients: Boolean;
  var
    I: Integer;
    AncestorClients: TJvBackgroundClients;
  begin
    AncestorClients := TJvBackgroundClients(Filer.Ancestor);
    if AncestorClients = nil then
      Result := True // FLinks.Count > 0
    else
    if AncestorClients.FLinks.Count <> FLinks.Count then
      Result := True
    else
    begin
      Result := False;
      for I := 0 to FLinks.Count - 1 do
      begin
        Result := not (Clients[I] = AncestorClients[I]);
        if Result then
          Break;
      end
    end;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Clients', ReadData, WriteData, WriteClients);
end;

procedure TJvBackgroundClients.ReadData(Reader: TReader);
begin
  Reader.ReadListBegin;
  while not Reader.EndOfList do
    FFixups.Add(Reader.ReadString);
  Reader.ReadListEnd;
end;

procedure TJvBackgroundClients.WriteData(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to FLinks.Count - 1 do
    Writer.WriteString(Clients[I].Name);
  Writer.WriteListEnd;
end;

procedure TJvBackgroundClients.FixupReferences(Root: TComponent);
var
  I: Integer;
  S: string;
  NextItem: TComponent;
begin
  FLinks.Clear;
  with FFixups do
  begin
    FLinks.Capacity := Capacity;
    for I := 0 to Count - 1 do
    begin
      S := Strings[I];
      if Root.Name = S then
        NextItem := Root
      else
        NextItem := Root.FindComponent(Strings[I]);
      if NextItem = nil then
        Break;
      if NextItem is TWinControl then
        Self.Add(TWinControl(NextItem));
    end;
  end;
end;

function TJvBackgroundClients.GetLink(Index: Integer): TJvBackgroundClientLink;
begin
  Result := TJvBackgroundClientLink(FLinks[Index]);
end;

procedure TJvBackgroundClients.Invalidate;
var
  I: Integer;
begin
  for I := 0 to FLinks.Count - 1 do
    Links[I].ClientInvalidate;
end;

//=== { TJvBackground } ======================================================

var
  Registered: Boolean = False;

constructor TJvBackground.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := AllocateHWnd(WndProc);
  FImage := TJvBackgroundImage.Create;
  FImage.FOnChange := WallpaperChanged;
  if Backgrounds = nil then
    Backgrounds := TList.Create;
  Backgrounds.Add(Self);
  FClients := TJvBackgroundClients.Create(Self);
  if csDesigning in ComponentState then
    if Assigned(Owner) then
      if Owner is TWinControl then
        FClients.Add(TWinControl(Owner));
  if not Registered then
  begin
    Classes.RegisterClasses([TJvBackgroundImage]);
    Registered := True;
  end;
end;

destructor TJvBackground.Destroy;
begin
  DeallocateHWnd(FHandle);
  FClients.Free;
  Backgrounds.Remove(Self);
  FImage.Free;
  inherited Destroy;
end;

procedure TJvBackground.Loaded;
begin
  inherited Loaded;
  FClients.FixupReferences(Owner);
end;

procedure TJvBackground.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if not (csDestroying in ComponentState) and Assigned(FClients) then
    FClients.Notification(AComponent, Operation);
  inherited Notification(AComponent, Operation);
end;

procedure TJvBackground.SetClients(Value: TJvBackgroundClients);
begin
  // dummy method to make Clients property visible in Object Inspector
end;

procedure TJvBackground.WallpaperChanged;
begin
  Clients.Invalidate;
end;

procedure TJvBackground.WndProc(var Msg: TMessage);
begin
  try
    case Msg.Msg of
      CM_RECREATEWINDOW:
        TJvBackgroundClientLink(Msg.lParam).HookClient;
      CM_RELEASECLIENTLINK:
        TJvBackgroundClientLink(Msg.lParam).Free;
    else
      Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
  except
    Application.HandleException(Self);
  end;
end;

procedure TJvBackground.SetImage(const Value: TJvBackgroundImage);
begin
  FImage.Assign(Value);
end;

function TJvBackground.HasClient(Control: TWinControl): Boolean;
begin
  Result := Clients.IndexOf(Control) >= 0;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(Hooked);
  FreeAndNil(Backgrounds);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.