Mumia W.
2010-04-21 19:15:19 UTC
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.
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.