Title: Add tile background to TScrollBox component
Question: How to add tile background picture to TScrollBox component?
Answer:
The easiest way to create a new component which one implements the new bitmap property.
-------------------------------------------------------------------------
Unit myscrollbox;
Interface
Uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs;
Type
tmyscrollbox = Class( tscrollbox )
Private
FBitmap: TBitmap;
Procedure SetBitmap( Const Value: TBitmap );
Procedure OnBitmapChange( Sender: TObject );
Procedure WMPaint( Var Message: TWMPaint ); Message WM_PAINT;
Protected
Procedure Paint; Virtual;
Public
Constructor Create( AOwner: TComponent ); Override;
Destructor Destroy; Override;
Published
Property Bitmap: TBitmap Read FBitmap Write SetBitmap;
End;
Procedure Register;
Implementation
Procedure Register;
Begin
RegisterComponents( 'Win32', [ tmyscrollbox ] );
End;
Constructor TMyScrollBox.Create( AOwner: TComponent );
Begin
Inherited Create( AOwner );
FBitmap := TBitmap.Create;
FBitmap.OnChange := OnBitmapChange;
End;
Destructor TMyScrollBox.Destroy;
Begin
FBitmap.Free;
Inherited Destroy;
End;
Procedure TMyScrollBox.OnBitmapChange( Sender: TObject );
Begin
Invalidate;
End;
Procedure TMyScrollBox.SetBitmap( Const Value: TBitmap );
Begin
FBitmap.Assign( Value );
End;
Procedure TMyScrollBox.Paint;
Var
X, Y, W, H: LongInt;
Rect: TRect;
DC: HDC;
Begin
Rect := GetClientRect;
W := FBitmap.Width;
H := FBitmap.Height;
Y := Rect.Top;
If ( H 0 ) And ( W 0 ) Then
Begin
DC := GetDC( Self.Handle );
While Y Begin
X := Rect.Left;
While X Begin
BitBlt( DC, X, Y, W, H, FBitmap.Canvas.Handle, 0, 0, SrcCopy );
Inc( X, W );
End;
Inc( Y, H );
End;
End;
End;
Procedure TMyScrollBox.WMPaint( Var Message: TWMPaint );
Begin
Inherited;
Paint;
End;
End.