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

I am having a problem to bind MouseWheel with Canvas: 
use Tk;

$mw = new MainWindow;
$main = $mw -> Scrolled("Canvas",-scrollbars=>'e')-> pack(-side => 'le
+ft', -fill => 'both', -expand => 1);
$canvas = $main->Subwidget("canvas");

Tk::bind($canvas, '<MouseWheel>', [ sub {$f->yview('scroll',-($_[1] / 
+120) * 3,'units')}, Ev('D')]); 

$see = "\nHaaa, See that and die!";
$info = $main->createText(180, 15, -text => "$see", -font => 'Arial 11
+ bold' , -fill => red);
$main->configure(-scrollregion => [0,0,2000 , 2000]);

$canvas_cube = $main->Canvas(-width => 15, -height => 15, -background 
+=> 'green');
$main ->createWindow(75,75, -window => $canvas_cube);

$canvas->focus;

MainLoop;

[download]
What I am doing wrong with that? Many thanks for your insight.

Replies are listed 'Best First'.
Re: Binding Canvas with MouseWheel
by lamprecht (Friar) on Mar 24, 2011 at 17:40 UTC

    I once wrote a small addon for Tk::Widget to make the setup of scrollable widget bindings easier and also allow for nested scrollable widgets. Check it out if you like, it made things much easier for me.

    Read more... (3 kB)
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = new MainWindow;
$mw->DynaMouseWheelBind('Tk::Canvas'); ## add more as needed like Tk::
+Text etc.
my $main = $mw -> Scrolled("Canvas",
                           -scrollbars=>'e',
                       )-> pack(-side => 'left',
                                -fill => 'both',
                                -expand => 1);

my $see = "\nHaaa, See that and die!";
my $info = $main->createText(180, 15,
                             -text => "$see",
                             -font => 'Arial 11 bold' ,
                             -fill => 'red');
$main->configure(-scrollregion => [0,0,2000 , 2000]);

my $canvas_cube = $main->Scrolled('Canvas',-width => 30, -height => 30
+, -background => 'green');
$canvas_cube->createText(15, 30, -text => "foo", -font => 'Arial 11 bo
+ld');
$canvas_cube->configure(-scrollregion => [0,0,100 , 100]);
$main ->createWindow(75,75, -window => $canvas_cube);

$main->focus;

MainLoop;

    [download]
[reply]
[d/l]
[select]

      DynaMouseWheelBind is great!

      Many thanks!

[reply]
Re: Binding Canvas with MouseWheel
by Anonymous Monk on Mar 24, 2011 at 15:56 UTC

    I made an mistake (cut/paste), the binding should be:
    Tk::bind($canvas, '<MouseWheel>', [ sub {$main->yview('scroll',-($_1 / +120) * 3,'units')}, Ev('D')]);

    Thanks.
[reply]
Re: Binding Canvas with MouseWheel
by zentara (Cardinal) on Mar 24, 2011 at 14:23 UTC
    I added 
    use warnings;
use strict;

    [download]
    and made a few fixes for that, and your script works with the mousewheel here. What problem do you see? 
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = new MainWindow;
my $main = $mw -> Scrolled("Canvas",-scrollbars=>'e')-> pack(-side => 
+'left', -fill => 'both', -expand => 1);

my $canvas = $main->Subwidget("canvas");

Tk::bind($canvas, '<MouseWheel>', [ sub {$canvas->yview('scroll',-($_[
+1] / 120) * 3,'units')}, Ev('D')]); 

my $see = "\nHaaa, See that and die!";

my $info = $main->createText(180, 15, -text => "$see", -font => 'Arial
+ 11 bold' , -fill => 'red');
$main->configure(-scrollregion => [0,0,2000 , 2000]);

my $canvas_cube = $main->Canvas(-width => 15, -height => 15, -backgrou
+nd => 'green');

$main ->createWindow(75,75, -window => $canvas_cube);

$canvas->focus;

MainLoop;

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom