summaryrefslogtreecommitdiff
path: root/plugins/Libs/KOLCCtrls.pas
blob: 01f1f25c9469c0ef10cb20e4c84edad01f9ae615 (plain)
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.