Perl-Tk MouseWheel support for Scale

perltux has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I'm trying to get MouseWheel support for the TK::Scale widget in Windows working but I don't really understand how. The few examples I've found on the Net refer to other widgets and don't seem to work for me when trying to apply them to a Scale widget.

Here is my test code (mouse wheel is not working with this code on Windows):

#!/usr/bin/perl

use strict;
use warnings;

use Tk;

my $var=0;
my $incr=1;
my $mw=MainWindow->new();


my $scale=$mw->Scale(
        -variable     =>  \$var,
        -to           =>  -63,
        -from         =>  63,
        -resolution   =>  $incr,
        -tickinterval =>  0,
        -label        =>  '',
        -width        =>  10,
        -length       =>  150,
        -sliderlength =>  20,
        -borderwidth  =>  1,
        -highlightthickness => 0,
        -showvalue    =>  1,
        -orient       =>  'vertical'
)->pack(-padx=>50);

# Linux/Unix mouse wheel binding
$scale->bind('<Button-4>' => sub{$scale->set($var+$incr)});
$scale->bind('<Button-5>' => sub{$scale->set($var-$incr)});

# Windows mouse wheel binding (not working)
$scale->bind('<MouseWheel>' => [ sub { $_[0]->set($var+$incr*($_[1] / 
+120))}, Ev('D') ] );

MainLoop;
[download]

How do I get this working on Windows? (on Linux it works fine, the binding is sooo much easier)

Comment on Perl-Tk MouseWheel support for Scale Download Code

Replies are listed 'Best First'.
Re: Perl-Tk MouseWheel support for Scale ( Tk::DynaMouseWheelBind ) by Anonymous Monk on Mar 06, 2015 at 07:54 UTC
I've not looked much at your code, but if you need wheel binding, you should use ~~Tk::DynaMouseWheelBind~~ Tk::DynaMouseWheelBind for all your wheel binding needs ... its came from an old book, posted at Re: Perl-Tk MouseWheel and Pane, but never on cpan ... weird	[reply]
Re^2: Perl-Tk MouseWheel support for Scale ( Tk::DynaMouseWheelBind ) by perltux (Monk) on Mar 06, 2015 at 18:02 UTC
Thanks, I will look into your module but I was hoping that all I needed for this was one or two lines, just like for Linux/Unix where two simple bindings are all that's needed.	[reply]
Re^3: Perl-Tk MouseWheel support for Scale ( Tk::DynaMouseWheelBind ) by Anonymous Monk on Mar 06, 2015 at 21:56 UTC
thanks i'll look at it later ... one two lines ... But the entire purpose of that module is to add those one/two lines for you, so you don't have to ... UTSL or use the module :)	[reply]
Re: Perl-Tk MouseWheel support for Scale by thundergnat (Deacon) on Mar 06, 2015 at 22:01 UTC
Your widget won't respond to bound events if it doesn't have the focus. Try putting a `$scale->focus;` somewhere before the MainLoop; This may or may not be of help to you. It assumes that there aren't any other widgets which may grab focus in your application. You may need to bind in some event to set the focus on the $scale when you want it to respond to mouse events. YMMV.	[reply] [d/l]
Re^2: Perl-Tk MouseWheel support for Scale by perltux (Monk) on Mar 06, 2015 at 23:29 UTC
Bingo! With `$scale->focus;` the mousewheel works on Windows too just like on Linux! Now I have to figure out how I can get FocusFollowsMouse on Windows as on Unix/Linux...	[reply] [d/l]
Re^3: Perl-Tk MouseWheel support for Scale ( Tk/DynaMouseWheelBind.pm ) by Anonymous Monk on Mar 06, 2015 at 23:56 UTC
Well, focusFollowsMouse works on win32 just fine `perl -MTk -le " $mw = tkinit; $mw->Button->pack for 1..3; $mw-> focusFollowsMouse ; MainLoop; "` But are you sure you want to do that? DynaMouseWheelBind allows scrolling at mouse position without changing focus :P Read more... (4 kB)	[reply] [d/l] [select]
Re^4: Perl-Tk MouseWheel support for Scale ( Tk/DynaMouseWheelBind.pm ) by perltux (Monk) on Mar 07, 2015 at 00:33 UTC
Re^5: Perl-Tk MouseWheel support for Scale ( Tk/DynaMouseWheelBind.pm ) by Anonymous Monk on Mar 07, 2015 at 00:44 UTC
Re: Perl-Tk MouseWheel support for Scale by perltux (Monk) on Mar 11, 2015 at 02:00 UTC
Solved it!! The following code works for me: `# Windows mouse wheel binding $scale->bind('<Enter>' => sub {$scale->focus} ); $scale->bind('<Leave>' => sub {$mw->focus}); $scale->bind('<MouseWheel>' => [ sub { $scale->set($var+$incr*($_[1] / + 120))}, Ev('D') ] );` [download] If anyone with more experience than myself finds any potential problems with my solution then please let me know, I'm a complete novice when it comes to Perl-Tk bindings so I have no idea whether my code, while apparently working, might have some fatal flaws...	[reply] [d/l]