in reply to Scrolling and marking by dragging on canvas

Hi tamaguchi,

You need to do several things to get a scrollable Canvas of the kind you've described.

Here is an example which does what you've asked for, which I've explained below:

#!/usr/bin/perl -w + use Tk; use strict; + my $mw = MainWindow->new; my $c = $mw->Scrolled('Canvas', -width => 100, -height => 100, -background =>'blue', -scrollregion => [ 0, 0, 500, 500 ] ); $c->pack(-expand => 1, -fill => 'both'); $c->createRectangle(100, 100, 150, 150, -fill => 'yellow'); + MainLoop;

You should use the method 'Scrolled' rather than 'Canvas', and call it with a first argument of 'Canvas'.  Also, you need to make the width and height 100, but allow a scrollRegion of 0 to 500 in both directions.

You'll notice that my code draws a yellow square to make it clear where the scrolling is occurring.

As far as rightclick and drag, it's not as simple as you may think.  You need to trap the left-mouse click event, and then draw a line/rectangle while the mouse is moving, but the button is still down.  It's a lot lower-level than just "drawing a rectangle with the mouse".

I'd recommend that you start by getting a copy of the excellent book "Mastering Perl/Tk", by Steve Lidie & Nancy Walsh, and published by O'Reilly.  It gives many great examples which will lead you through the process of becoming a Perl/Tk expert.


s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Replies are listed 'Best First'.
Re^2: Scrolling and marking by dragging on canvas
by tamaguchi (Pilgrim) on Sep 22, 2006 at 14:05 UTC
    Thank you liverpole. I dont expect the dragging and marking to be easy, but is it possible to do in -tk? I mean is there support to do it in principle or is not possible? I guess there is support to do it in principle, beacouse I can not imagine that something like this could be "not possible" in principle in Perl.
      Hi tamaguchi,

      You're most welcome!

      Yes, such a thing is possible in Tk.  I'll give you an example so you can see how to do it, but you'll see that it's fairly involved.  It's not that any of the individual steps are particularly difficult, just that there is a lot of preparation work to do.

      I'll use the example above as a starting point:

      #!/usr/bin/perl -w use Tk; use strict; # Globals my $b_button_1_down = 0; # Is the left mouse button currently down? my ($x0, $y0, $x1, $y1); # Starting and ending (x,y) coordinates my $rect_id = 0; # Last rectangle drawn # Main program / GUI setup my $mw = MainWindow->new; my $c = $mw->Scrolled('Canvas', -width => 100, -height => 100); $c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 +]); $c->pack(-expand => 1, -fill => 'both'); bind_left_mouse($c); MainLoop; # Subroutines sub bind_left_mouse { my ($c) = @_; # Create "callback"; subroutines which get called whenever the # corresponding event is triggered. Note that Ev('x') and Ev('y') # will tell us, at the time they're used, what the current (x,y) # coordinate pair was. # my $cb1 = [ \&left_mouse_down, $c, Ev('x'), Ev('y')]; my $cb2 = [ \&left_mouse_release, $c, Ev('x'), Ev('y')]; my $cb3 = [ \&left_mouse_moving, $c, Ev('x'), Ev('y')]; # Bind the callbacks $c->CanvasBind("<ButtonPress-1>", $cb1); $c->CanvasBind("<ButtonRelease-1>", $cb2); $c->CanvasBind("<Motion>", $cb3); } sub left_mouse_down { # This gets called whenever the left-mouse button is clicked my ($ev, $c, $x, $y) = @_; $b_button_1_down = 1; ($x0, $y0) = ($x, $y); print "(debug) button1 down, (x,y) => ($x,$y)\n"; } sub left_mouse_moving { # This gets called whenever the mouse moves. It's true for ALL # mouse motion, but we're really just interested in when the mouse # is moving -and- the left mouse button is held down; hence the na +me. # my ($ev, $c, $x, $y) = @_; return unless $b_button_1_down; print "(debug) button1 moving, (x,y) => ($x,$y)\n"; $rect_id and $c->delete($rect_id); # Delete any old rectangle firs +t $rect_id = $c->createRectangle($x0, $y0, $x, $y, -fill => 'yellow' +); } sub left_mouse_release { # This gets called whenever the left-mouse button is released my ($ev, $c, $x, $y) = @_; $b_button_1_down = 0; ($x1, $y1) = ($x, $y); print "(debug) button1 release, (x,y) => ($x,$y)\n"; # Now do something with the triangle at (x0,y0,x1,y1)... $rect_id and $c->delete($rect_id); # Delete any old rectangle firs +t $rect_id = $c->createRectangle($x0, $y0, $x, $y, -fill => 'red'); }

      What the above program does is to create a yellow rectange when you first click the left mouse button.  The rectangle then changes its shape in response to the mouse being moved around.  When you release the mouse button, the rectangle turns red.

      You can take out the lines containing "(debug)", which are there to show the events that are being triggered.

      You'll notice that the final rectangle is currently removed when you start a new one; you would have to add logic to keep it if you needed to.

      I hope that's a good starting point for you to work with.  There is a LOT of good things you can do with Perl/Tk, and although it takes some time to master it (and I'm still learning), it's well worth the enjoyable experience.


      s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
        Damit you are good at this!!! Thank you.
        You are very good at this. Thank you very much for your help.