Discussion:
Can not intercept and disable MouseWheel on a canvas
(too old to reply)
Mumia W.
2010-04-21 19:15:19 UTC
Permalink
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
2010-04-21 21:59:48 UTC
Permalink
Post by 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
#!/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.
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.
2010-04-22 00:30:04 UTC
Permalink
Post by Lamprecht
Post by 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
#!/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.
Hi Mumia,
check <Button-4> and <Button-5> event handlers,
(<MouseWheel> is a Windows thing).
Christoph
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
2010-04-22 07:06:02 UTC
Permalink
Post by Mumia W.
Post by Lamprecht
Post by Mumia W.
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.
Hi Mumia,
check <Button-4> and <Button-5> event handlers,
(<MouseWheel> is a Windows thing).
Christoph
Thanks, that sort of works. I can intercept mouse wheel events, but I
$canvas->CanvasBind('<Button-4>', '');
$canvas->CanvasBind('<Button-5>', '');
However, I still get scrolling. Can I disable that?
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.
2010-04-22 14:27:04 UTC
Permalink
Post by Lamprecht
Post by Mumia W.
Post by Lamprecht
Post by Mumia W.
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.
Hi Mumia,
check <Button-4> and <Button-5> event handlers,
(<MouseWheel> is a Windows thing).
Christoph
Thanks, that sort of works. I can intercept mouse wheel events, but I
$canvas->CanvasBind('<Button-4>', '');
$canvas->CanvasBind('<Button-5>', '');
However, I still get scrolling. Can I disable that?
It seems to be the Window manager, that does this.
$canvas->CanvasBind("<$_>", sub {
$canvas->yviewMoveto( 0 )})for (4,5);
$canvas->CanvasBind("<4>", sub {
$canvas->yviewScroll( 1,'units' )});
$canvas->CanvasBind("<5>", sub {
$canvas->yviewScroll( -1,'units' )});
Cheers, Christoph
The code using yviewMoveto works quite well. Thank you very much.
:-)
p***@gmail.com
2014-06-18 10:30:13 UTC
Permalink
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.
Post by Mumia W.
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]
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.
j***@gmail.com
2018-08-22 09:33:13 UTC
Permalink
Excellent, paran! Adding -scrollregion => [0, 0, $Sxmax, $Symax] solved my problem under Linux.
Loading...