Author: Tomas Rutkauskas
How to create a TScrollBox with an own background
Answer:
1 unit NScroll;
2
3 interface
4
5 uses
6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms;
7
8 type
9 TMyScrollBox = class(TScrollBox)
10 private
11 FNHBitmap: TBitmap;
12 FNHCanvas: TCanvas;
13 procedure WMPaint(var message: TWMPaint); message WM_PAINT;
14 procedure SetBitmap(Value: TBitmap);
15 protected
16 procedure Painting;
17 procedure PaintWindow(DC: HDC); override;
18 published
19 property BackBitmap: TBitmap read FNHBitmap write SetBitmap;
20 public
21 constructor Create(Owner: TComponent); override;
22 destructor Destroy; override;
23 end;
24
25 procedure register;
26
27 implementation
28
29 constructor TMyScrollBox.Create(Owner: TComponent);
30 begin
31 inherited Create(Owner);
32 FNHBitmap := TBitmap.Create;
33 FNHCanvas := TControlCanvas.Create;
34 TControlCanvas(FNHCanvas).Control := Self;
35 end;
36
37 destructor TMyScrollBox.Destroy;
38 begin
39 FNHBitmap.Destroy;
40 FNHCanvas.Destroy;
41 inherited Destroy;
42 end;
43
44 procedure TMyScrollBox.SetBitmap(Value: TBitmap);
45 begin
46 FNHBitmap.Assign(Value);
47 invalidate;
48 end;
49
50 procedure TMyScrollBox.WMPaint(var message: TWMPaint);
51 begin
52 PaintHandler(message);
53 end;
54
55 procedure TMyScrollBox.PaintWindow(DC: HDC);
56 begin
57 FNHCanvas.Handle := DC;
58 try
59 Painting;
60 finally
61 FNHCanvas.Handle := 0;
62 end;
63 end;
64
65 procedure TMyScrollBox.Painting;
66 var
67 FDrawHeight, FDrawWidth: Integer;
68 Row, Column, xl, xt, xw, xh: Integer;
69 xdl, xdt: Integer;
70 xRect: TRect;
71 i: integer;
72 xhdl: Word;
73 begin
74 if (FNHBitmap.width <> 0) and (FNHBitmap.Height <> 0) then
75 begin
76 xRect := ClientRect;
77 FDrawHeight := xRect.Bottom - xRect.Top;
78 FDrawWidth := xRect.Right - xRect.Left;
79 xdl := (HorzScrollBar.Position mod FNHBitmap.Width);
80 xdt := (VertScrollBar.Position mod FNHBitmap.Height);
81 for Row := 0 to (FDrawHeight div FNHBitmap.Height) + 1 do
82 begin
83 for Column := 0 to (FDrawWidth div FNHBitmap.Width) + 1 do
84 begin
85 xl := Column * FNHBitmap.Width + xRect.Left - xdl;
86 xt := Row * FNHBitmap.Height + xRect.Top - xdt;
87 xw := FNHBitmap.Width;
88 if (FDrawWidth - xl + xRect.Left) < xw then
89 xw := (FDrawWidth - xl + xRect.Top);
90 xh := FNHBitmap.Height;
91 if (FDrawHeight - xt + xRect.Top) < xh then
92 xh := (FDrawHeight - xt + xRect.Top);
93 FNHCanvas.CopyRect(Rect(xl, xt, xl + xw, xt + xh), FNHBitmap.Canvas,
94 Rect(0, 0, xw, xh));
95 end;
96 end;
97 end;
98 end;
99
100 procedure register;
101 begin
102 RegisterComponents('Samples', [TMyScrollBox]);
103 end;
104
105 end.
|
