Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

How to move up/down the row element in a ListBox/Mlistbox

by ghosh123 (Monk)
on Feb 01, 2012 at 06:46 UTC ( #951130=perlquestion: print w/ replies, xml ) Need Help??
ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks, I need one push in regard to move a row element up and down by clicking a button or pressing Up/Down key. Let us consider this small code below ================================================
my $mw = MainWindow -> new(); my $lb = $mw -> Scrolled("Listbox", -scrollbars=>'e' , ) -> pack( -side => 'left' , -fill => 'y' ); foreach my $key ("first" , "second" , "third", "fourth") { $lb -> insert( 'end', $key ); } $lb->activate ( 0 ) ; $lb->selectionSet ( 0 ) ; $lb->focus; $lb -> bind ('<Key-Down>', sub {print "Down\n"} ); $mw -> bind ('<Key-Up>', sub {print "\nUP"} ); MainLoop;
================================================== Now the items appear as "first", "second" ,"third" and "fourth" in row1 row2,row3 and row4 respectively. My requirement is to alter the order of appearence by clicking or pressing up/down key. For example after the order would appear as "second" "first" "fouth" and "third". Kindly help . Thanks in advance. -AG

Comment on How to move up/down the row element in a ListBox/Mlistbox
Download Code
Re: How to move up/down the row element in a ListBox/Mlistbox
by chessgui (Scribe) on Feb 01, 2012 at 07:13 UTC
    Something like (untested):
    $UP=-1; $DOWN=1; sub move { my $lb=shift; my $direction=shift; my $cur=$lb->curselection(); $cur+=$direction; my $size=$lb->size(); $cur=0 if $cur>=$size; $cur=$size-1 if $cur<0; $lb->see($cur); }
    usage: move($lb,$UP); move($lb,$DOWN); (only works if one and only one element is selected)
Re: How to move up/down the row element in a ListBox/Mlistbox
by GrandFather (Cardinal) on Feb 01, 2012 at 07:24 UTC

    Binding to the up and down arrow keys is somewhat problematic because they are already used for list box navigation. However using 'x' and 'e' for the down and up keys you can reorder the list as follows:

    #!usr/bin/perl use strict; use warnings; use Tk; my $mw = MainWindow->new(); my $lb = $mw->Scrolled("Listbox", -scrollbars => 'e',)->pack( -side => 'left', -fill => 'y' ); for my $key ("first", "second", "third", "fourth") { $lb->insert('end', $key); } $lb->activate(0); $lb->selectionSet(0); $lb->focus(); $lb->bind('<x>', sub {down($lb, @_)}); $mw->bind('<e>', sub {up($lb, @_)}); MainLoop; sub down { my ($lb) = @_; my @selItems = $lb->curselection(); return if 1 != @selItems || $selItems[0] == $lb->size(); my $item = $lb->get($selItems[0]); $lb->delete($selItems[0]); $lb->insert($selItems[0] + 1, $item); $lb->selectionSet($selItems[0] + 1); } sub up { my ($lb) = @_; my @selItems = $lb->curselection(); return if 1 != @selItems || $selItems[0] == 1; my $item = $lb->get($selItems[0]); $lb->delete($selItems[0]); $lb->insert($selItems[0] - 1, $item); $lb->selectionSet($selItems[0] - 1); }
    True laziness is hard work
Re: How to move up/down the row element in a ListBox/Mlistbox
by thundergnat (Deacon) on Feb 01, 2012 at 16:59 UTC

    If you are doing it in a GUI, why not do it with the GUI? Drag and drop, baby!

    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::DragDrop; use Tk::DropSite; my %tk; my $font = '{Helvetica} 14'; $tk{mw} = MainWindow->new; $tk{lbframe} = $tk{mw}->Frame->pack( -expand => 1, -fill => 'both', -anchor => 'nw' ); $tk{listbox} = $tk{lbframe}->Scrolled( 'Listbox', -selectmode => 'single', -scrollbars => 'ose', -font => $font, )->pack( -expand => 1, -fill => 'both', -padx => 5, -pady => 5, ); $tk{listbox}->insert( 'end', $_) for qw/first second third fourth fift +h etc./; my $dnd_token = $tk{listbox}->DragDrop( -event => '<B1-Motion>', -sitetypes => [qw/Local/], -startcommand => \&DragStart, ); $tk{listbox}->DropSite( -droptypes => [qw/Local/], -dropcommand => [ \&Drop, $tk{listbox}, $dnd_token ], ); MainLoop; sub DragStart { my ($token) = @_; my $site = $token->parent; my $e = $site->XEvent; my $idx = $site->index( '@' . $e->x . ',' . $e->y ); if ( defined $idx ) { $token->configure( -text => $site->get($idx), -font => $font ) +; $site->delete($idx); my ( $X, $Y ) = ( $e->X, $e->Y ); $token->MoveToplevelWindow( $X, $Y ); $token->raise; $token->deiconify; $token->FindSite( $X, $Y, $e ); } } sub Drop { my ( $site, $token ) = @_; my $text = $token->cget('-text'); my $y = $site->pointery - $site->rooty; my $nearest = $site->nearest($y); if ( defined $nearest ) { my @xy = $site->bbox($nearest); if ( $xy[1] + $xy[3] > $y ) { $site->insert( $nearest, $text ); } else { $site->insert( 'end', $text ); } } }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://951130]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2014-12-18 22:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (67 votes), past polls