in reply to How to make a Tk::Button move/slide within a Tk::Table
I wasn't sure of the desired behavior, (should each button be replaced as you drag over it, or should only the beginning and ending button be swapped?) so each is in here. Uncomment the appropriate line(s) in the slideTo{} sub.
Also, I changed the drag binding to the right mouse button so it wouldn't collide with left button presses. Change it back if that isn't what you want.
Your addButton command logic seems over-complex too, but I didn't mess with it as I wasn't sure what else you might be using it for.
use warnings; use strict; use Tk; use Tk::Table; use Data::Dumper; my $buttonsPerRow = 5; $buttonsPerRow -= 1; my $row = 0; my $col = 1; my $buttonNum = 0; my @buttons; my $mw = tkinit(); my $menuFrame = $mw->Frame()->pack( -expand => 1, -fill => 'both' ); my $buttonFrame = $mw->Frame()->pack( -expand => 1, -fill => 'both' ); my $table = $buttonFrame->Table( -columns => 5, -scrollbars => 'se', -fixedrows => 1, )->pack( -expand => 1, -fill => 'both' ); my $addButton = $menuFrame->Button( -text => 'Add Button', -command => sub { $buttons[$buttonNum] = $table->Button(); print "Button $buttonNum->$row:$col\n"; $buttons[$buttonNum]{'row'} = $row; $buttons[$buttonNum]{'col'} = $col; $table->put( $row, $col, $buttons[$buttonNum] ); configureButton($buttonNum); $col > $buttonsPerRow ? $row++ : undef; $col > $buttonsPerRow ? $col = 1 : $col++; $buttonNum++; }, )->pack( -side => 'top' ); ################################ my $isDragging = 0; #boolean - mouse button pressed and draggi +ng my $selectedButton = 0; my ( @original, @previous ); $mw->bind( '<Motion>', \&motion ); ################################ $mw->MainLoop(); sub configureButton { my $btnNum = shift; $buttons[$btnNum]->bind( '<Enter>', sub { $selectedButton = $btnNum; } ); $buttons[$btnNum]->configure( -text => "Button $btnNum", -command => sub { print "Button $btnNum pressed\n"; } ); $buttons[$btnNum]->bind( '<ButtonPress-3>', \&buttonPress ); $buttons[$btnNum]->bind( '<ButtonRelease-3>', \&buttonRelease ); } sub motion { slideTo( findCell( $_[0] ) ) if $isDragging; } sub buttonPress { $isDragging = 1; @original = @previous = findCell( $_[0] ); } sub buttonRelease { $isDragging = 0; } sub findCell { my $e = $_[0]->XEvent; my ( $row, $col ) = $table->Posn( $table->containing( $e->X, $e->Y + ) ); return ( $row, $col ); } sub slideTo { my @next = @_; if ( $previous[0] == $next[0] and $previous[1] == $next[1] ) { return; # still in same cell } else { #swap( \@previous, \@next ); # depending on desired behaviour, uncomment either the previou +s or the next two lines swap( \@previous, \@original ); swap( \@original, \@next ); @previous = @next; } } sub swap { my ( $this, $that ) = @_; my $s1 = $table->get(@$this); my $s2 = $table->get(@$that); $s2->UnmanageGeometry; $table->LostSlave($s2); $table->put( @$this, $s2 ); $table->put( @$that, $s1 ); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: How to make a Tk::Button move/slide within a Tk::Table
by bcarroll (Pilgrim) on Feb 09, 2012 at 19:22 UTC |