Create a Scroll Box with Bitmap Background

It's simple to create it.
1. Create a new object inherits from TScrollBox
2. We need two variables,
TBitmap variable to save bitmap
TCanvas variable to draw bitmap on scrollbox
3. Define a BackBitmap property on published area so the property
can change from Object Inspector.
4. Inherits the WM_PAINT message handler
5. Define a Painting procedure to draw bitmap.
6. Override PaintWindow procedure for paint scrollbox.
the object type is
type
TMyScrollBox = Class(TScrollBox) (* an object inherited from TScrollbox *)
private
FNHBitmap: TBitmap; (* TBitmap variable to save bitmap *)
FNHCanvas: TCanvas; (* TCanvas variable to draw bitmap *)
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
(* Override the WM_PAINT message handler *)
procedure SetBitmap(Value: TBitmap);
(* procedure to set bitmap. Used by BackBitmap property *)
protected
procedure Painting; (* procedure to draw bitmap *)
procedure PaintWindow(DC: HDC); override; (* Procedure to paint window *)
published
property BackBitmap: TBitmap read FNHBitmap write SetBitmap;
(* BackBitmap Property *)
public
constructor Create(Owner: TComponent); override;
(* Constructor to create object *)
destructor Destroy; override;
(* Destructor to destroy object *)
end;
6. Constructor to create object.
At this procedure, create the TCanvas variable as TControlCanvas.
The TControlCanvas is an object inherited from TCanvas that can be used to
draw on Control Surface.
Set the property Control on this variable to Self.
constructor TMyScrollBox.Create(Owner: TComponent);
begin
inherited Create(Owner);
FNHBitmap := TBitmap.Create;
FNHCanvas := TControlCanvas.Create; (* Create as a TControl Canvas *)
TControlCanvas(FNHCanvas).Control := Self;
(* Set the Control property so you can draw on the scrollbox surface. *)
end;
7. Procedure Painting
This procedure is used to draw on the scrollbox surface.
You must use the vertical scrollbar position and horizontal scrollbar position
to draw the bitmap, and repeat drawing for tiling bitmap.
9. Message trapping
When the scrollbox get WM_PAINT message, then the message will be handled by
WMPaint procedure. The WMPaint procedure calls PaintHandler, so the control's
background will be painted by calling PaintWindow and any child controls too
by calling PaintControls.
The Painting procedure is called by PaintWindow.
You can copy this source, save as NScroll.pas, and install to your component palette.
　
(* Source Code *)
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('KPC', [TMyScrollBox]);
end;
　
　
　
end.