Discussion :

[alainbb]

Bonjour,

Je suis en train de faire une interface de dessin en Tk, et j'ai un
problème avec les liaisons d'événements.
Je voudrais créer une gomme qui efface tout ce qu'elle voit sur son
passage quand le bouton gauche est enfoncé.
Si j'essaye la séquence B1-motion, il faut cliquer sur l'objet et
bouger la souris pour que l'objet s'efface.
Un variante qui marche bien est Alt-Enter, mais c'est évidemment la
touche Alt qui est enfoncée, hors je voudrais le bouton gauche de la
souris.

si vous avez une idée...

Bien le merci.
AlainBB

Un code démo

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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");
my $oval=$drawing->createOval(0,0,100,100,-fill=>"red");
 
# fonctionne en cliquant sur le cercle
#$drawing->bind("all", "<ButtonPress>", sub {$drawing->delete($oval);});
 
# fonctionne en gardant le alt enfoncé et en passant avec la souris sur cercle
#$drawing->bind("all", "<Alt-Motion>", sub {$drawing->delete($oval);});
 
# ne fonctionne pas en gardant le bouton de souris enfoncé et en passant avec la souris sur cercle
$drawing->bind("all", "<B1-Motion>", sub {$drawing->delete($oval);});
 
MainLoop;

[djibril]

C'est assez étrange ce comportement. En effet B1-Motion ne semble pas fonctionner comme voulu.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
$drawing->bind("all", "<B1-Motion>", sub {$drawing->delete($oval);});
$drawing->Tk::bind("all", "<B1-Motion>", sub {$drawing->delete($oval);});

Ne donne rien.

Une dernière solution consiste à utiliser CanvasBind

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

$drawing->CanvasBind("all", "<B1-Motion>", sub {$drawing->delete($oval);});

et là ça fonctionne. Par contre le comportement n'est surement pas adapté car il vide complétement ton widget dès que tu bouges (la souris le bouton 1 enfoncé).
Pour faire quelque chose de propre, tu peux intercepter la position de ta souris et supprimer les éléments aux environs (en jouant avec les tags), voici un programme d'exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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;

Le principe revient à créer un rectangle et de récupérer les tags des éléments le chevauchant.

[alainbb]

Cela fonctionne en effet comme je veux. Faut-il vraiment jouer avec les tags ? J'ai l'impression que l'ID est toujours en premier et donc qu'il suffit de le récupérer et d'effacer le bon objet grâce à celui-ci.

J'ai modifié juste la fin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/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 {
print ".";
  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 = $drawing->find( 'overlapping', $x - $pixel, $y - $pixel, $x + $pixel, $y + $pixel );
 
  # 2 - suppression
  if (@tags) {
     print $tags[0];
     $drawing->delete($tags[0]);
  }
}
 
MainLoop;

[alainbb]

# 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 = $drawing->find( 'overlapping', $x - $pixel, $y - $pixel, $x + $pixel, $y + $pixel );
[/code]

Et plus précisement (je veux dire que la souris est plus précise :-)
my @tags = $drawing->find( 'overlapping', $x , $y , $x , $y );

La doc dit en effet $x1 <= $x2... donc le rectangle peut se limiter à un point.

[djibril]

N'oublie pas de passer ton post en résolu .