1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
{$INCLUDE Switches.inc}
unit PVSB;
interface
uses
{$IFDEF WINDOWS}Windows,{$ENDIF}
Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils,
StdCtrls, Math;
type
{ TPVScrollbar }
TPVScrollBar = class
private
FOnUpdate: TNotifyEvent;
ScrollBar: TScrollBar;
FMax: Integer;
function GetMax: Integer;
function GetPageSize: Integer;
function GetPosition: Integer;
procedure ScrollBarChanged(Sender: TObject);
procedure SetMax(AValue: Integer);
procedure SetPageSize(AValue: Integer);
procedure SetPosition(AValue: Integer);
public
constructor Create(Parent: TWinControl);
destructor Destroy; override;
procedure Init(Max, PageSize: Integer);
procedure SetPos(Pos: Integer);
function Process(const Msg: TMessage): boolean;
function ProcessMouseWheel(Delta: Integer): Boolean;
procedure Show(Visible: boolean);
procedure EndSB;
procedure SetBorderSpacing(Top, Right, Bottom: Integer);
property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
property Position: Integer read GetPosition write SetPosition;
property Max: Integer read GetMax write SetMax;
property PageSize: Integer read GetPageSize write SetPageSize;
end;
implementation
const
Count: Integer = 0;
procedure TPVScrollBar.Init(Max, PageSize: Integer);
begin
ScrollBar.PageSize := PageSize;
ScrollBar.Min := 0;
Self.Max := Max;
ScrollBar.Position := 0;
ScrollBar.Visible := Max >= ScrollBar.PageSize;
end;
procedure TPVScrollBar.SetPos(Pos: Integer);
begin
if Pos <> 0 then begin
ScrollBar.Position := Pos;
end;
end;
function TPVScrollBar.Process(const Msg: TMessage): boolean;
var
NewPos: integer;
begin
if Max < ScrollBar.PageSize then
result := false
else
begin
if (Msg.wParam and $ffff) in [SB_THUMBPOSITION, SB_THUMBTRACK] then
begin
result := ((Msg.wParam shr 16) and $ffff) <> ScrollBar.Position;
ScrollBar.Position := (Msg.wParam shr 16) and $ffff;
end else begin
case (Msg.wParam and $ffff) of
SB_LINEUP:
NewPos := ScrollBar.Position - 1;
SB_LINEDOWN:
NewPos := ScrollBar.Position + 1;
SB_PAGEUP:
NewPos := ScrollBar.Position - ScrollBar.PageSize;
SB_PAGEDOWN:
NewPos := ScrollBar.Position + ScrollBar.PageSize;
else
NewPos := ScrollBar.Position
end;
if NewPos < 0 then
NewPos := 0;
if NewPos > Max - ScrollBar.PageSize + 1 then
NewPos := Max - ScrollBar.PageSize + 1;
result := NewPos <> ScrollBar.Position;
if (NewPos <> ScrollBar.Position) or ((Msg.wParam and $ffff) = SB_ENDSCROLL) then
begin
ScrollBar.Position := NewPos;
end;
end;
end;
end;
function TPVScrollBar.ProcessMouseWheel(Delta: Integer): Boolean;
var
NewPos: integer;
begin
if Max < ScrollBar.PageSize then Result := False
else begin
NewPos := ScrollBar.Position - Delta div 30;
if NewPos < 0 then NewPos := 0;
if NewPos > Max - ScrollBar.PageSize + 1 then
NewPos := Max - ScrollBar.PageSize + 1;
Result := NewPos <> ScrollBar.Position;
if NewPos <> ScrollBar.Position then begin
ScrollBar.Position := NewPos;
end;
end;
end;
procedure TPVScrollBar.Show(Visible: boolean);
begin
if not Visible or (Max < ScrollBar.PageSize) then
ScrollBar.Visible := False
else ScrollBar.Visible := True;
end;
procedure TPVScrollBar.EndSB;
begin
if Max < ScrollBar.PageSize then
ScrollBar.Position := 0 // hidden
else begin
ScrollBar.Position := Max - ScrollBar.PageSize + 1;
end;
end;
procedure TPVScrollBar.SetBorderSpacing(Top, Right, Bottom: Integer);
begin
ScrollBar.BorderSpacing.Top := Top;
ScrollBar.BorderSpacing.Right := Right;
ScrollBar.BorderSpacing.Bottom := Bottom;
end;
{ TPVScrollbar }
procedure TPVScrollBar.ScrollBarChanged(Sender: TObject);
begin
if Assigned(FOnUpdate) then FOnUpdate(Self);
end;
procedure TPVScrollBar.SetMax(AValue: Integer);
begin
FMax := AValue;
ScrollBar.Max := Math.Max(0, FMax);
end;
procedure TPVScrollBar.SetPageSize(AValue: Integer);
begin
ScrollBar.PageSize := AValue;
end;
function TPVScrollBar.GetPosition: Integer;
begin
Result := ScrollBar.Position;
end;
function TPVScrollBar.GetMax: Integer;
begin
Result := FMax;
end;
function TPVScrollBar.GetPageSize: Integer;
begin
Result := ScrollBar.PageSize;
end;
procedure TPVScrollBar.SetPosition(AValue: Integer);
begin
ScrollBar.Position := AValue;
end;
constructor TPVScrollBar.Create(Parent: TWinControl);
begin
Inc(Count);
ScrollBar := TScrollBar.Create(Parent);
ScrollBar.Kind := sbVertical;
ScrollBar.Name := 'PVSB' + IntToStr(Count);
ScrollBar.Align := alRight;
ScrollBar.OnChange := ScrollBarChanged;
ScrollBar.Parent := Parent;
end;
destructor TPVScrollBar.Destroy;
begin
FreeAndNil(ScrollBar);
end;
end.
|
