Re: Tk-Canvas Grouping

As far as the "active fill" not working is concerned, it's because you have "-state =>'disabled' in their setup. That makes them essentially 'inactive'. If you are looking for a way to change their colors on "enter and leave", you need to setup a binding on each small rect or tag them.

That brings up a big point you are missing. Tags!! I'm not sure what you are trying to accomplish exactly, but you make no use of tags, and you need to. I like to use hashes instead of arrays, and with that in mind, here is a script which may help you understand things. You have to play around with it a bit, to get the hang of it. I took the group out, since it was just getting in the way. Show us a full working script which uses the group, if you want us to help you with it.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new();

# first create a canvas widget 
my $c = $mw->Canvas(width => 300, height => 200)->pack();

my $x1 = 10;
my $x2 = 20;
my $parent = $c->createRectangle(10, 20, 100, 60,
                  -fill => 'red',
                  -tags => ['parent'],
                  );

my %children;

for my $i (1..4) {
 $children{$i} =  $c->createRectangle($x1, 20, $x2, 30,
    #-state =>'disabled',  
    -activefill  => 'green',
    -disabledfill => 'white',
    -tags => ['children',$i],
    );

     $x1 += 15; $x2 += 15;
  }



my $ebutton = $mw->Button(-text => 'Exit',
                  -command => 'Tk::exit')->pack();


$c->Tk::bind("<Motion>", \&get_info  );

MainLoop();

sub get_info{
 my $curr_object = $c->find('withtag','current');
   if(defined $curr_object){
     print "curr->",@$curr_object,"\n";  #array dereference 
     my (@list) = $c->gettags($curr_object);
     print "list->@list\n";
    }
}
[download]

I'm not really a human, but I play one on earth. flash japh

Comment on Re: Tk-Canvas Grouping Download Code

Replies are listed 'Best First'.
Re^2: Tk-Canvas Grouping by Anonymous Monk on Jun 21, 2005 at 13:51 UTC
I'm using CanvasBind to bind <B1-Motion> to allow me to drag the group around the screen similar to below: `sub drag_group { my ($c) = @_; my $e = $c->XEvent; # get the screen position of the move... my ( $sx, $sy ) = ( $e->x, $e->y,,, ); print "\t screen: $sx, $sy\n"; # get the canvas position... my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) ); print "\t canvas: $cx, $cy\n"; # get the amount to move... my ( $dx, $dy ) = ( $cx - $draginfo{lastx}, $cy - $draginfo{lasty} + ); print "\t dx, dy = $dx, $dy\n"; # move it... $c->move( $draginfo{id}, $dx, $dy ); }` [download] The problem I'm having is that once grouped I can't seem to click or mouse over the child rectangles. I'm able to identify the id's by using: `sub items_retrieve { my $id = shift; my @items = @{$group{$id}{items}}; return @items; }` [download]	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: Tk-Canvas Grouping
by Anonymous Monk on Jun 21, 2005 at 13:51 UTC

sub drag_group {
    my ($c) = @_;
    my $e = $c->XEvent;
    # get the screen position of the move...
    my ( $sx, $sy ) = ( $e->x, $e->y,,, );
    print "\t screen: $sx, $sy\n";
    # get the canvas position...
    my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) );
    print "\t canvas: $cx, $cy\n";
    # get the amount to move...
    my ( $dx, $dy ) = ( $cx - $draginfo{lastx}, $cy - $draginfo{lasty}
+ );
    print "\t dx, dy = $dx, $dy\n";
    
    # move it...
    $c->move( $draginfo{id}, $dx, $dy );
}
[download]

sub items_retrieve {
    my $id = shift;
    my @items = @{$group{$id}{items}};
    return @items;
}
[download]

[reply]
[d/l]
[select]