Quivis
2006-08-07 09:54:27 UTC
[ D5, XP-Pro ]
Hi,
I have this idea to use a TCheckListBox for certain activities on my
form, only I would like it to scroll horizontally using the mouse wheel.
Another criterium is that there should be only one column of items, not
two or more.
I came up with the following code (thanks to various people on the
Delphi groups for hints):
First I created my own descendant of TCheckListBox and published the
protected OnMouseWheel property. Then in the code to my form:
procedure TForm1.FormCreate(Sender: TObject);
var
I, MaxWidth: Integer;
begin
lsb := TMyCheckListBox.Create(Self);
with lsb do
begin
Parent := Form1;
SetBounds(10, 10, 200, 200);
OnMouseWheel := DaMouseWheel;
Items.Add('This is a very long long ...
[... adding several long strings for testing]
MaxWidth:=0;
for i := 0 to Items.Count - 1 do
if MaxWidth < Canvas.TextWidth(Items[i]) then
MaxWidth := Canvas.TextWidth(Items[i]);
if MaxWidth > Width - 4 then
SendMessage(Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 20, 0)
else
SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
end;
NewDelta := 0;
OldDelta := 0;
end;
procedure TForm1.DaMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
OldDelta := NewDelta;
NewDelta := WheelDelta;
if (ssCtrl in Shift) and (lsb.Items.Count > 0) then
with lsb do
begin
if OldDelta < NewDelta then
begin
{ Make it scroll left }
SendMessage(Handle, WM_HSCROLL, SB_LINELEFT, 0);
NewDelta := 0;
end
else
begin
{ Make it scroll right }
SendMessage(Handle, WM_HSCROLL, SB_LINERIGHT, 0);
OldDelta := 0;
end;
Handled := True;
end;
end;
Now, this does work, the TCheckListBox does scroll both left and right
if you press the Ctrl button while you scroll using the mouse wheel and
defaults back to scrolling up and down if you release the Ctrl button,
but is there another approach to all this code? It looks kinda bloated.
Never mind the manually added code for creating the special
TCheckListBox. That will go away later.
In short, how can I stuff all this into the actual component?
TIA for some fresh ideas.
Q.
Hi,
I have this idea to use a TCheckListBox for certain activities on my
form, only I would like it to scroll horizontally using the mouse wheel.
Another criterium is that there should be only one column of items, not
two or more.
I came up with the following code (thanks to various people on the
Delphi groups for hints):
First I created my own descendant of TCheckListBox and published the
protected OnMouseWheel property. Then in the code to my form:
procedure TForm1.FormCreate(Sender: TObject);
var
I, MaxWidth: Integer;
begin
lsb := TMyCheckListBox.Create(Self);
with lsb do
begin
Parent := Form1;
SetBounds(10, 10, 200, 200);
OnMouseWheel := DaMouseWheel;
Items.Add('This is a very long long ...
[... adding several long strings for testing]
MaxWidth:=0;
for i := 0 to Items.Count - 1 do
if MaxWidth < Canvas.TextWidth(Items[i]) then
MaxWidth := Canvas.TextWidth(Items[i]);
if MaxWidth > Width - 4 then
SendMessage(Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 20, 0)
else
SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
end;
NewDelta := 0;
OldDelta := 0;
end;
procedure TForm1.DaMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
OldDelta := NewDelta;
NewDelta := WheelDelta;
if (ssCtrl in Shift) and (lsb.Items.Count > 0) then
with lsb do
begin
if OldDelta < NewDelta then
begin
{ Make it scroll left }
SendMessage(Handle, WM_HSCROLL, SB_LINELEFT, 0);
NewDelta := 0;
end
else
begin
{ Make it scroll right }
SendMessage(Handle, WM_HSCROLL, SB_LINERIGHT, 0);
OldDelta := 0;
end;
Handled := True;
end;
end;
Now, this does work, the TCheckListBox does scroll both left and right
if you press the Ctrl button while you scroll using the mouse wheel and
defaults back to scrolling up and down if you release the Ctrl button,
but is there another approach to all this code? It looks kinda bloated.
Never mind the manually added code for creating the special
TCheckListBox. That will go away later.
In short, how can I stuff all this into the actual component?
TIA for some fresh ideas.
Q.
--
Take back the web:
http://www.spreadfirefox.com/?q=user/register&r=114898
Take back the web:
http://www.spreadfirefox.com/?q=user/register&r=114898