首页  编辑  

Create a Scroll Box with Bitmap Background

Tags: /超级猛料/VCL/Panel,GroupBox,RadioGroup,ScrollBox等/   Date Created:

]、。·ˉˇ¨〃々—~‖…’”〕〉》」』〗】∶!"'),.:;?]` 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.