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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
unit KOLCCtrls;
interface
{$I KOLDEF.INC}
uses
windows, messages, KOL;
{ ====== TRACKBAR CONTROL CONSTANTS =================== }
const
TRACKBAR_CLASS = 'msctls_trackbar32';
TBS_AUTOTICKS = $0001;
TBS_VERT = $0002;
TBS_HORZ = $0000;
TBS_TOP = $0004;
TBS_BOTTOM = $0000;
TBS_LEFT = $0004;
TBS_RIGHT = $0000;
TBS_BOTH = $0008;
TBS_NOTICKS = $0010;
TBS_ENABLESELRANGE = $0020;
TBS_FIXEDLENGTH = $0040;
TBS_NOTHUMB = $0080;
TBS_TOOLTIPS = $0100;
TBM_GETPOS = WM_USER;
TBM_GETRANGEMIN = WM_USER+1;
TBM_GETRANGEMAX = WM_USER+2;
TBM_GETTIC = WM_USER+3;
TBM_SETTIC = WM_USER+4;
TBM_SETPOS = WM_USER+5;
TBM_SETRANGE = WM_USER+6;
TBM_SETRANGEMIN = WM_USER+7;
TBM_SETRANGEMAX = WM_USER+8;
TBM_CLEARTICS = WM_USER+9;
TBM_SETSEL = WM_USER+10;
TBM_SETSELSTART = WM_USER+11;
TBM_SETSELEND = WM_USER+12;
TBM_GETPTICS = WM_USER+14;
TBM_GETTICPOS = WM_USER+15;
TBM_GETNUMTICS = WM_USER+16;
TBM_GETSELSTART = WM_USER+17;
TBM_GETSELEND = WM_USER+18;
TBM_CLEARSEL = WM_USER+19;
TBM_SETTICFREQ = WM_USER+20;
TBM_SETPAGESIZE = WM_USER+21;
TBM_GETPAGESIZE = WM_USER+22;
TBM_SETLINESIZE = WM_USER+23;
TBM_GETLINESIZE = WM_USER+24;
TBM_GETTHUMBRECT = WM_USER+25;
TBM_GETCHANNELRECT = WM_USER+26;
TBM_SETTHUMBLENGTH = WM_USER+27;
TBM_GETTHUMBLENGTH = WM_USER+28;
TBM_SETTOOLTIPS = WM_USER+29;
TBM_GETTOOLTIPS = WM_USER+30;
TBM_SETTIPSIDE = WM_USER+31;
// TrackBar Tip Side flags
TBTS_TOP = 0;
TBTS_LEFT = 1;
TBTS_BOTTOM = 2;
TBTS_RIGHT = 3;
TBM_SETBUDDY = WM_USER+32; // wparam = BOOL fLeft; (or right)
TBM_GETBUDDY = WM_USER+33; // wparam = BOOL fLeft; (or right)
TBM_SETUNICODEFORMAT = CCM_SETUNICODEFORMAT;
TBM_GETUNICODEFORMAT = CCM_GETUNICODEFORMAT;
TB_LINEUP = 0;
TB_LINEDOWN = 1;
TB_PAGEUP = 2;
TB_PAGEDOWN = 3;
TB_THUMBPOSITION = 4;
TB_THUMBTRACK = 5;
TB_TOP = 6;
TB_BOTTOM = 7;
TB_ENDTRACK = 8;
// custom draw item specs
TBCD_TICS = $0001;
TBCD_THUMB = $0002;
TBCD_CHANNEL = $0003;
{ ^^^^^^^^ TRACKBAR CONTROL ^^^^^^^^ }
type
PTrackbar = ^TTrackbar;
TTrackbarOption = ( trbAutoTicks, trbEnableSelRange, trbFixedLength,
trbNoThumb, trbNoTicks, trbTooltips, trbTopLeftMarks,
trbVertical, trbNoBorder );
TTrackbarOptions = Set Of TTrackbarOption;
TOnScroll = procedure( Sender: PTrackbar; Code: Integer ) of object;
{* Code:
|<pre>
TB_THUMBTRACK Slider movement (the user dragged the slider)
TB_THUMBPOSITION WM_LBUTTONUP following a TB_THUMBTRACK notification message
TB_BOTTOM VK_END
TB_ENDTRACK WM_KEYUP (the user released a key that sent a relevant virtual key code)
TB_LINEDOWN VK_RIGHT or VK_DOWN
TB_LINEUP VK_LEFT or VK_UP
TB_PAGEDOWN VK_NEXT (the user clicked the channel below or to the right of the slider)
TB_PAGEUP VK_PRIOR (the user clicked the channel above or to the left of the slider)
TB_TOP VK_HOME
|</pre>
}
TTrackbar = object( TControl )
private
function GetOnScroll: TOnScroll;
procedure SetOnScroll(const Value: TOnScroll);
function GetVal( const Index: Integer ): Integer;
procedure SetVal(const Index, Value: Integer);
procedure SetThumbLen(const Index, Value: Integer);
procedure SetTickFreq(const Value: Integer);
procedure SetNumTicks(const Index, Value: Integer);
protected
public
property OnScroll: TOnScroll read GetOnScroll write SetOnScroll;
property RangeMin: Integer index $80010007 read GetVal write SetVal;
property RangeMax: Integer index $80020008 read GetVal write SetVal;
property PageSize: Integer index $00160015 read GetVal write SetVal;
{* to scroll with PgUp/PgDn }
property LineSize: Integer index $00180017 read GetVal write SetVal;
{* to scroll with arrow keys }
property Position: Integer index $80000005 read GetVal write SetVal;
property NumTicks: Integer index $00100000 read GetVal write SetNumTicks;
{* set approximately via TickFreq, returns actual tick mark count }
property TickFreq: Integer write SetTickFreq;
{* 2 means that one tick will be drawn for 2 tick marks }
property SelStart: Integer index $0011000B read GetVal write SetVal;
property SelEnd : Integer index $0012000C read GetVal write SetVal;
property ThumbLen: Integer index $001B0000 read GetVal write SetThumbLen;
{* trbFixedLength should be on to have effect }
function ChannelRect: TRect;
end;
TKOLTrackbar = PTrackbar;
function NewTrackbar( AParent: PControl; Options: TTrackbarOptions; OnScroll: TOnScroll ): PTrackbar;
implementation
type
PTrackbarData = ^TTrackbarData;
TTrackbarData = packed record
FOnScroll: TOnScroll;
end;
function WndProcTrackbarParent( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT ): Boolean;
var D: PTrackbarData;
Trackbar: PTrackbar;
begin
Result := FALSE;
if (Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL) then
if (Msg.lParam <> 0) then
begin
{$IFDEF USE_PROP}
Trackbar := Pointer( GetProp( Msg.lParam, ID_SELF ) );
{$ELSE}
Trackbar := Pointer( GetWindowLongPtr( Msg.lParam, GWLP_USERDATA ) );
{$ENDIF}
if Trackbar <> nil then
begin
D := Trackbar.CustomData;
if Assigned( D.FOnScroll ) then
D.FOnScroll( Trackbar, Msg.wParam );
end;
end;
end;
function NewTrackbar( AParent: PControl; Options: TTrackbarOptions; OnScroll: TOnScroll ): PTrackbar;
const TrackbarOptions: array[ TTrackbarOption ] of Integer = ( TBS_AUTOTICKS,
TBS_ENABLESELRANGE, TBS_FIXEDLENGTH, TBS_NOTHUMB, TBS_NOTICKS, TBS_TOOLTIPS,
TBS_TOP, TBS_VERT, 0 );
var aStyle: DWORD;
D: PTrackbarData;
W, H: Integer;
begin
DoInitCommonControls( ICC_BAR_CLASSES );
aStyle := MakeFlags( @Options, TrackbarOptions ) or WS_CHILD or WS_VISIBLE;
Result := PTrackbar( _NewCommonControl( AParent, TRACKBAR_CLASS, aStyle,
not (trbNoBorder in Options), nil ) );
W := 200;
H := 40;
if trbVertical in Options then
begin
H := W;
W := 40;
end;
Result.Width := W;
Result.Height := H;
GetMem( D, Sizeof( D^ ) );
Result.CustomData := D;
D.FOnScroll := OnScroll;
AParent.AttachProc( WndProcTrackbarParent );
end;
{ TTrackbar }
function TTrackbar.ChannelRect: TRect;
begin
Perform( TBM_GETCHANNELRECT, 0, LPARAM( @ Result ) );
end;
function TTrackbar.GetOnScroll: TOnScroll;
var D: PTrackbarData;
begin
D := CustomData;
Result := D.FOnScroll;
end;
function TTrackbar.GetVal( const Index: Integer ): Integer;
begin
Result := Perform( WM_USER + ( HiWord( Index ) and $7FFF ), 0, 0 );
end;
procedure TTrackbar.SetNumTicks(const Index, Value: Integer);
begin
TickFreq := (RangeMax - RangeMin) div Value;
end;
procedure TTrackbar.SetOnScroll(const Value: TOnScroll);
var D: PTrackbarData;
begin
D := CustomData;
D.FOnScroll := Value;
end;
procedure TTrackbar.SetThumbLen(const Index, Value: Integer);
begin
Perform( TBM_SETTHUMBLENGTH, Value, 0 );
end;
procedure TTrackbar.SetTickFreq(const Value: Integer);
begin
Perform( TBM_SETTICFREQ, Value, 0 );
end;
procedure TTrackbar.SetVal(const Index, Value: Integer);
begin
Perform( WM_USER + LoWord( Index ), Index shr 31, Value );
end;
end.
|