How to create a TScrollBox with an own background

Mirror

How to create a TScrollBox with an own background (Views: 8)

Problem/Question/Abstract:

How to create a TScrollBox with an own background

Answer:

unit NScroll;

interface

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

type
  TMyScrollBox = class(TScrollBox)
  private
    FNHBitmap: TBitmap;
    FNHCanvas: TCanvas;
    procedure WMPaint(var Message: 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 Message: TWMPaint);
begin
  PaintHandler(Message);
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.

<< Back to main page