Can not intercept and disable MouseWheel on a canvas

[Mumia W.]

I am having a problem disabling or replacing the MouseWheel
default callback routine for a canvas.

I have an application that uses a canvas; unfortunately, I also have
a habit of turning the mouse wheel at random times. Most applications
ignore this, but the Tk canvas widget scrolls its content when it
receives MouseWheel events.

I've tried to disable this misfeature using several methods. Here is an
example program that shows the problem:

#!/usr/bin/perl
use strict;
use warnings;
use Tk;

my $main = MainWindow->new;
my $f1 = $main->Frame(-width => 300, -height => 300,
-bd => 1, -relief => 'solid');

my $canvas = $f1->Canvas(-width => 150, -height => 110,
-bg => 'orange')->pack;
my $rect_id = $canvas->createRectangle(20, 20, 100, 100,
-fill => 'white');
my $rect2_id = $canvas->createRectangle(120, 20, 140, 40,
-fill => 'white');
# $canvas->bind($rect_id, 'Button2-MouseWheel', sub { print "Wheel
event\n" }); # ignored
# $canvas->itemconfigure('all', -state => 'disabled');
# $canvas->bind('<Button-1>', sub { print "Sonorm\n" }); # ignored
# $canvas->configure(-state => 'disabled'); # ignored
# $canvas->bind($rect_id, '<ButtonRelease-1>', sub { print "Btn-1\n" });
# $canvas->bind('<MouseWheel>', sub { print "MouseWheel\n" });
# $canvas->CanvasBind('<Button-2>', sub { print "Here-button\n"; });
$canvas->CanvasBind('<MouseWheel>', sub { print "Mwheel\n"; });

$f1->Button(-text => 'Okay', -command => [$main, 'destroy'])->pack;
$f1->packPropagate(1);
$f1->pack;

MainLoop;

__END__

None of these methods, and a dozen others I tried, work to disable
mouse-wheel scrolling for canvas widgets. How do I do this? I'm using
Debian 5.0, Perl 5.10.0 and Perl-tk 804.028.

[Lamprecht]

Hi Mumia,

check <Button-4> and <Button-5> event handlers,
(<MouseWheel> is a Windows thing).

Christoph

--
PDM-Descriptions - a Perl implementation of 'Magritte'
- validated forms built from meta descriptions
http://sites.google.com/site/vlclamprecht/Home/perl

[Mumia W.]

Thanks, that sort of works. I can intercept mouse wheel events, but I
still can't disable the scrolling. I tried this:

$canvas->CanvasBind('<Button-4>', '');
$canvas->CanvasBind('<Button-5>', '');

However, I still get scrolling. Can I disable that?

[Lamprecht]

It seems to be the Window manager, that does this.

You can force an yview reset:

$canvas->CanvasBind("<$_>", sub {
$canvas->yviewMoveto( 0 )})for (4,5);

Or set up a negative scollbinding (possibly needs adjustment of the number):
$canvas->CanvasBind("<4>", sub {
$canvas->yviewScroll( 1,'units' )});
$canvas->CanvasBind("<5>", sub {
$canvas->yviewScroll( -1,'units' )});

Cheers, Christoph

--
Tk::EntrySet
display/edit a list of values in a Set of Widgets.
Tk::ChoicesSet
display/edit a list of choices in a Set of single-selection Widgets.

[Mumia W.]

The code using yviewMoveto works quite well. Thank you very much.
:-)

[paran...@gmail.com]

Hi Mumia

It been a while since you asked this question but this was the first article found when I searched for this problem so I thought I would add my solution.

The simplest method to stop the canvas scrolling is to set the scrollregion to be the same size as the canvas. In your example you would replace:

my $canvas = $f1->Canvas(-width => 150, -height => 110,
-bg => 'orange')->pack;

with:

my $canvas = $f1->Canvas(-width => 150, -height => 110,

-bg => 'orange', -scrollregion => [ 0, 0, 150, 110 ])->pack;

If you don't know the size of the canvas when you create it then you can use the cget to get the width and height after it is created and the use configure method to set the scrollregion.

On Wednesday, April 21, 2010 8:15:19 PM UTC+1, Mumia W. wrote:

> I have an application that uses a canvas; unfortunately, I also have
> a habit of turning the mouse wheel at random times. Most applications
> ignore this, but the Tk canvas widget scrolls its content when it
> receives MouseWheel events.
>

> [chomp]

[jdyb...@gmail.com]

Excellent, paran! Adding -scrollregion => [0, 0, $Sxmax, $Symax] solved my problem under Linux.