Внешний вид сайта:

Добавление фона в компонент TScrollBox

Как добавить фоновое изображение в компонент? Самый легкий способ — создать новый компонент, который осуществляет новое свойство изображения.
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 < Height Do 
           Begin 
               X := Rect.Left; 
               While X < Width Do 
               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. 

Комментарии

Нет комментариев. Ваш будет первым!