source: tags/1.2.0/LocalPlayer/PVSB.pas

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