1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| #!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new;
my $drawing = $mw->Scrolled(
'Canvas',
-width => 800,
-height => 400,
-confine => 0,
-background => "white"
)->pack( -side => "left" );
$drawing->createOval( 0, 0, 100, 100, -fill => "red", -tags => 'toto' );
$drawing->createOval( 100, 100, 200, 200, -fill => "green" );
$drawing->createOval( 300, 300, 350, 350, -fill => "yellow", -tags => [ 'toto', 'cercle' ] );
# Evénement pour gommer
$drawing->CanvasBind( 'all', "<B1-Motion>", [ \&Gommer, Ev('x'), Ev('y') ] );
# Procédure pour gommer
sub Gommer {
my ( $canvas, $x, $y ) = @_;
# A partir des coordonnées x et y de la souris, on gomme (ou supprime) les éléments compris
# aux alentours de 2 pixels
my $pixel = 2;
# 1 - récupération des tags des éléments
my @tags = $canvas->find( 'overlapping', $x - $pixel, $y - $pixel, $x + $pixel, $y + $pixel );
# 2 - suppression
foreach my $tag (@tags) {
print "Numero tag : $tag supprime\n";
my @nom_tag = $canvas->gettags($tag);
if ( scalar @nom_tag != 0 ) {
print "Nom tag associe : @nom_tag\n";
}
else {
print "Pas de tags associe\n";
}
$canvas->delete($tag);
}
}
MainLoop; |
Partager