Scroll only when mouse over

Question

I am trying to provide scrolling behaviour on a GUI developed using Perl TK.

What I would like to achieve is, when the mouse is over a widget such as a Scrolled containing a ListBox, the user should be able to scroll up and down using the mouse wheel. The mouse counts as being over the widget if it is over the widget itself or the scrollbars at the sides of the widget. In over words, if the mouse is anywhere over the Scrolled and not just the ListBox.

I have included an example below that works when the mouse is over the ListBox but it does not work if it is just outside the ListBox but it is still on the Scrolled.

It is worth noting, for the mouse wheel support, this is Windows specific on my example.

Example script

#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $mainWindow = new MainWindow;

my $lb = $mainWindow->Scrolled("Listbox", -scrollbars => "osoe")->pack;

$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);

my $lbCanScroll = 0;
$mainWindow->bind('<MouseWheel>' => [sub{ if($lbCanScroll) { $lb->yview('scroll', -($_[1] / 120) * 3, 'units'); } }, Ev('D')]);
$lb->bind('<Leave>' => sub{$lbCanScroll = 0});
$lb->bind('<Enter>' => sub{$lbCanScroll = 1});

MainLoop;

---

Whilst I have posted what I will call a temporary solution, it would be nice to know if there was a more reusable way to achieve this.

Answer 1

As a temporary solution, I can put it in a wrapper object that stores only that one component. This allows me to bind to the Enter and Leave events on that object. It looks a bit like

#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $mainWindow = new MainWindow;

my $lbHolder = $mainWindow->Pane()->pack;

my $lb = $lbHolder->Scrolled("Listbox", -scrollbars => "osoe")->pack;

$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);

my $lbCanScroll = 0;
$mainWindow->bind('<MouseWheel>' => [sub{ if($lbCanScroll) { $lb->yview('scroll', -($_[1] / 120) * 3, 'units'); } }, Ev('D')]);
$lbHolder->bind('<Leave>' => sub{$lbCanScroll = 0});
$lbHolder->bind('<Enter>' => sub{$lbCanScroll = 1});

MainLoop;