The New PerlTk.org - Interacting with Canvas Items
www.mamboteam.com
The New PerlTk.org  
Home
Thursday, 21 August 2014
 
 
Main Menu
Home
Perl/Tk Widgets
Articles
Scripts
Useful Tips
Links
Contact Us
Search
FAQs
Login Form
Username

Password

Remember me
Forgotten your password?
No account yet? Create one
Interacting with Canvas Items PDF Print E-mail
Written by Ala Qumsieh   
By Ala Qumsieh (ala_qumsieh at yahoo dot com)

Ever wanted to interactively resize or move Canvas rectangles?
If so, then this tutorial is for you.

In this tutorial, what we'll attempt to do is the following:

Given a Canvas rectangle we would like to be able to drag it around with the mouse and interactively resize it by clicking somewhere close to an edge or a corner, and then dragging that edge or corner as we like. For our specific case, we will assume that if we click within 20% of an edge, then we want to resize the rectangle. Else (if we click in the middle of the rectangle, for example), we want to move it. Of course, this 20% value is arbitrary, and you can customize it to your liking.

First thing to do is to create our main window and canvas area:


    #!perl -w

    use strict;
    use Tk;

    my $mw   = new MainWindow;

    my $canv = $mw->Canvas(qw/
                           -bg     black
                           -width  500
                           -height 500
                           /)->pack(qw/-expand 1/);
Here, we created a 500 x 500 black Canvas. Now, we want to create some rectangles. For this, I like to define a simple function that will draw a square of arbitrary size wherever we click on the canvas with the right mouse button.

    $canv->CanvasBind('<3>' => sub {
        my ($x, $y) = ($Tk::event->x, $Tk::event->y);
        my $size = int rand 100;
        $canv->createRectangle($x, $y, 
                               $x+$size, $y+$size,
                               -tags => ['RECT'],
                               -fill => 'white');
    });
Notice that we tag all our rectangles with 'RECT' so that we can identify them and bind to them later on.

Now we finish off the program with the following two lines:


    bindForResize($canv);
    MainLoop;
The bindForResize() subrouting (defined below) is the one that does all the work. It basically defines our Canvas bindings that will define what will happen when we click and move the mouse.

This subroutine starts off like so:


    sub bindForResize {
        my $canv = shift;

        my $dx   = 0;
        my $dy   = 0;
        my $mode = 0;    # 0 => move
                         # 1 => resize
        my $pct  = 0.2;
        my $oldx = 0;
        my $oldy = 0;
        my $rect;
The following variables are defined:
  $dx is 1 if we want to drag the left edge of the rectangle, 
        -1 if we want to drag the right edge of the rectangle, 
         0 otherwise. 

  $dy is 1 if we want to drag the top edge of the rectangle, 
        -1 if we want to drag the bottom edge of the rectangle, 
         0 otherwise. 

  $mode is 1 if we clicked close to an edge (ie. resize mode), 
           0 if not (ie. move mode). 

  $pct is how close to an edge we have to click so we can go into resize mode. 20% by default. 

  $oldx, $oldy just keep track of where the mouse pointer was previously. 

  $rect will hold the id of the rectangle we're resizing. 
All of those variables are necessary as we will see shortly. Now, we will bind to a left button click over any of our rectangles (as defined by the 'RECT' tag) such that if we clicked close enough to an edge, we update $dx and $dy. We'll also update $mode accordingly. And set $rect to the rectangle we're dealing with. If we're in resize mode, then we draw a red outline that will show us the new size of our rectangle as we are dragging its edges.

Here's how it looks like.


    $canv->bind('RECT' => '<1>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);
                    my @coords  = $canv->coords($id);

                    my $width   = $coords[2] - $coords[0];
                    my $height  = $coords[3] - $coords[1];

                    if      ($x < $coords[0] + 0.2 * $width) {
                        $dx = 1;
                    } elsif ($x > $coords[2] - 0.2 * $width) {
                        $dx = -1;
                    } else {
                        $dx = 0;
                    }

                    if      ($y < $coords[1] + 0.2 * $height) {
                        $dy = 1;
                    } elsif ($y > $coords[3] - 0.2 * $height) {
                        $dy = -1;
                    } else {
                        $dy = 0;
                    }

                    $mode = ($dx || $dy) ? 1 : 0;
                    $oldx = $x;
                    $oldy = $y;
                    $rect = $id;

                    if ($mode) {
                        $canv->createRectangle(@coords,
                                               -outline => 'red',
                                               -tags    => ['TEMP'],
                                               );
                    }

                    return;
                });
In the above code, the first thing we did was to get the current mouse position, and id of the rectangle we clicked on. Then, using the rectangle's coordinates, we get its width and height. We then use those to see how close we clicked relative to an edge and to set $dx and $dy. Finally, we set $mode and other data. If we are in resize mode, we create our guiding outline and tag it with 'TEMP'.

The next step is to react to mouse movements with the left button pressed. If we are in move mode, then simply move the rectangle. If we're in resize mode, then figure out which edges need to move, and drag them along with the mouse. The code looks like this:


    $canv->bind('RECT' => '<B1-Motion>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);

                    if ($mode) {  # resize
                        my @coords = $canv->coords('TEMP');

                        if    ($dx ==  1) { $coords[0] = $x }
                        elsif ($dx == -1) { $coords[2] = $x }

                        if    ($dy ==  1) { $coords[1] = $y }
                        elsif ($dy == -1) { $coords[3] = $y }

                        $canv->coords('TEMP', @coords);
                    } else {      # move
                        $canv->move($id => $x - $oldx, $y - $oldy);
                        $oldx = $x;
                        $oldy = $y;
                    }
                });
Again, the first thing is to get the current mouse location and the id of the object we're working with.

Now, if we're in resize mode, then update the coordinates of the temporary guiding outline as defined by the $dx and $dy variables.
If we're in move mode, simply move the rectangle by an amount equal to the difference in the current mouse position and the previous mouse position. We shouldn't forget to update the previous mouse position to the current one in preparation for the next mouse movement; so we do that.

So far, in resize mode, we haven't really resized our rectangle. All we did was create an outline, and resize that. To finish up we bind to the release of the left mouse button, as so:


    $canv->CanvasBind('<B1-ButtonRelease>' => sub {
        my @coords = $canv->coords('TEMP');

        # Delete the rectangle.
        $canv->delete('TEMP');

        $canv->coords($rect => @coords);
    });
Here, whenever we release the left button anywhere on the canvas we get the coordinates of our temporary guiding outline, delete it since we don't need it anymore, and then resize our rectangle based on these coordinates.

That's it. The complete program looks like this:


#!perl

use strict;
use warnings;
use Tk;

my $mw   = new MainWindow;

my $canv = $mw->Canvas(qw/
                       -bg     black
                       -width  500
                       -height 500
                       /)->pack(qw/-expand 1/);

$canv->CanvasBind('<3>' => sub {
    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
    my $size = int rand 100;
    $canv->createRectangle($x, $y, 
                           $x+$size, $y+$size,
                           -tags => ['RECT'],
                           -fill => 'white');
});

bindForResize($canv);

MainLoop;

sub bindForResize {
    my $canv = shift;

    my $dx   = 0;
    my $dy   = 0;
    my $mode = 0;    # 0 => move
                     # 1 => resize
    my $pct  = 0.2;
    my $oldx = 0;
    my $oldy = 0;
    my $rect;

    $canv->bind('RECT' => '<1>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);
                    my @coords  = $canv->coords($id);

                    my $width   = $coords[2] - $coords[0];
                    my $height  = $coords[3] - $coords[1];

                    if      ($x < $coords[0] + 0.2 * $width) {
                        $dx = 1;
                    } elsif ($x > $coords[2] - 0.2 * $width) {
                        $dx = -1;
                    } else {
                        $dx = 0;
                    }

                    if      ($y < $coords[1] + 0.2 * $height) {
                        $dy = 1;
                    } elsif ($y > $coords[3] - 0.2 * $height) {
                        $dy = -1;
                    } else {
                        $dy = 0;
                    }

                    $mode = ($dx || $dy) ? 1 : 0;
                    $oldx = $x;
                    $oldy = $y;
                    $rect = $id;

                    if ($mode) {
                        $canv->createRectangle(@coords,
                                               -outline => 'red',
                                               -tags    => ['TEMP'],
                                               );
                    }

                    return;
                });

    $canv->bind('RECT' => '<B1-Motion>' =>
                sub {
                    my ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    my $id      = $canv->find(qw/withtag current/);

                    if ($mode) {  # resize
                        my @coords = $canv->coords('TEMP');

                        if    ($dx ==  1) { $coords[0] = $x }
                        elsif ($dx == -1) { $coords[2] = $x }

                        if    ($dy ==  1) { $coords[1] = $y }
                        elsif ($dy == -1) { $coords[3] = $y }

                        $canv->coords('TEMP', @coords);
                    } else {      # move
                        $canv->move($id => $x - $oldx, $y - $oldy);
                        $oldx = $x;
                        $oldy = $y;
                    }
                });

    $canv->CanvasBind('<B1-ButtonRelease>' => sub {
        my @coords = $canv->coords('TEMP');

        # Delete the rectangle.
        $canv->delete('TEMP');

        $canv->coords($rect => @coords);
    });
}

__END__

Comments
Written by nikhil on 2005-09-01 00:40:30
THis Program rocks!! :grin  
 
Thumbs UP!!
Written by nikhil on 2005-09-01 00:46:57
may be if there is some upper bound on size ,that I can put on a rectangle? 
I notice that the rectangles keep disappearing as I keep reducing the size of rectangle? 
 
Thanks for the excellent article Ala
Upper Bound
Written by ala on 2005-09-25 21:54:03
Sure, you can implement this very easily. This code is just to show one possible way to interact with Canvas objects. You should modify it to suit your needs.

Only registered users can write comments.
Please login or register.

Powered by AkoComment 2.0!

< Prev   Next >
 
Top! Top!