How to create a TScrollBox with its own background #121

unit NScroll;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms;

type
  TMyScrollBox = Class(TScrollBox)
  private
    FNHBitmap: TBitmap;
    FNHCanvas: TCanvas;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetBitmap(Value: TBitmap);
  protected
    procedure Painting;
    procedure PaintWindow(DC: HDC); override;
  published
    property BackBitmap: TBitmap read FNHBitmap write SetBitmap;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
end;

procedure Register;

implementation

constructor TMyScrollBox.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FNHBitmap := TBitmap.Create;
  FNHCanvas := TControlCanvas.Create;
  TControlCanvas(FNHCanvas).Control := Self;
end;

destructor TMyScrollBox.Destroy;
begin
  FNHBitmap.Destroy;
  FNHCanvas.Destroy;
  inherited Destroy;
end;

procedure TMyScrollBox.SetBitmap(Value: TBitmap);
begin
  FNHBitmap.Assign(Value);
  invalidate;
end;

procedure TMyScrollBox.WMPaint(var Msg: TWMPaint);
begin
  PaintHandler(Msg);
end;

procedure TMyScrollBox.PaintWindow(DC: HDC);
begin
  FNHCanvas.Handle := DC;
  try
    Painting;
  finally
    FNHCanvas.Handle := 0;
  end;
end;

procedure TMyScrollBox.Painting;
var
  FDrawHeight, FDrawWidth: Integer;
  Row, Column, xl, xt, xw, xh: Integer;
  xdl, xdt: Integer;
  xRect: TRect;
  i: integer;
  xhdl: Word;
begin
  if (FNHBitmap.width <> 0) and (FNHBitmap.Height <> 0) then
  begin
    xRect := ClientRect;
    FDrawHeight := xRect.Bottom - xRect.Top;
    FDrawWidth := xRect.Right - xRect.Left;
    xdl := (HorzScrollBar.Position mod FNHBitmap.Width);
    xdt := (VertScrollBar.Position mod FNHBitmap.Height);
    for Row := 0 to (FDrawHeight div FNHBitmap.Height) + 1 do
    begin
      for Column := 0 to (FDrawWidth div FNHBitmap.Width) + 1 do
      begin
        xl := Column * FNHBitmap.Width + xRect.Left - xdl;
        xt := Row * FNHBitmap.Height + xRect.Top - xdt;
        xw := FNHBitmap.Width;
        if (FDrawWidth - xl + xRect.Left) < xw then
          xw := (FDrawWidth - xl + xRect.Top);
        xh := FNHBitmap.Height;
        if (FDrawHeight - xt + xRect.Top) < xh then
          xh := (FDrawHeight - xt + xRect.Top);
        FNHCanvas.CopyRect(
          Rect(xl, xt, xl + xw, xt + xh),
          FNHBitmap.Canvas,
          Rect(0, 0, xw, xh)
        );
      end;
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMyScrollBox]);
end;

end.