Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Insert checkbutton into MListbox

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

Hi , I want to insert some checkbuttons as row into a MListbox widget. I am currently trying with ItemStyle and TList. But ItemStyle only supports image , text , imagetext and window. How can I insert checkbutton then? Please help. Thanks.

Replies are listed 'Best First'.
Re: Insert checkbutton into MListbox
by thundergnat (Deacon) on Feb 02, 2012 at 16:13 UTC

    I'm not familiar with Mlistbox but after a quick perusal of the docs, it look like it is based on a Listbox primitive rather than one of the tix based List widgets. (TList, Hlist, tixGrid, etc.) Listboxs are designed and optimized to work with text items. I'm not sure if it is possible to make them work with other types of items without major aggravation.

    For what it is worth, here is an example Checkbuttons in a TList (which IS a tix based List widget)

    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::TList; my %tk; $tk{mw} = MainWindow->new; $tk{tlist} = $tk{mw}->TList( )->pack( -expand => 1, -fill => 'both', ); my @cbvar = ( 0, 1, 1, 0, 0 ); for ( 0 .. $#cbvar ){ $tk{"cb$_"} = $tk{tlist}->Frame; $tk{"cb$_"}->Checkbutton( -variable => \$cbvar[$_] )->pack( -side => 'left' ); $tk{"cb$_"}->Label( -text => " Checkbox $_ " )->pack( -side => 'left' ); $tk{tlist}->insert( 'end', -itemtype => 'window', -widget => $tk{"cb$_"}, ); } MainLoop;
Re: Insert checkbutton into MListbox
by zentara (Archbishop) on Feb 02, 2012 at 17:01 UTC
    Just to broaden your toolkit horizons, Gtk2 will do it.
    #!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2 -init; use Gtk2::Ex::Simple::List; my $win = Gtk2::Window->new; $win->set_title ('Gtk2::Ex::Simple::List exapmle'); $win->set_border_width (6); $win->set_default_size (500, 300); $win->signal_connect (delete_event => sub { Gtk2->main_quit; }); my $hbox = Gtk2::HBox->new (0, 6); $win->add ($hbox); my $scwin = Gtk2::ScrolledWindow->new; $hbox->pack_start ($scwin, 1, 1, 0); $scwin->set_policy (qw/automatic automatic/); my $slist = Gtk2::Ex::Simple::List->new ( 'Text Field' => 'text', 'Bool Field1' => 'bool', 'Bool Field2' => 'bool', 'Bool Field3' => 'bool', ); @{$slist->{data}} = ( [ '1text', TRUE, TRUE, TRUE ], [ '2text', TRUE, FALSE, TRUE ], ); # (almost) anything you can do to an array you can do to # $slist->{data} which is an array reference tied to the list model push @{$slist->{data}}, [ '9text', FALSE, FALSE, TRUE ]; # mess with selections $slist->get_selection->set_mode ('multiple'); $slist->get_selection->unselect_all; $slist->select (1, 3, 5..9); # select rows by index $slist->unselect (3, 8); # unselect rows by index my @sel = $slist->get_selected_indices; # simple way to make text columns editable my $col_num = 0; $slist->set_column_editable ($col_num, TRUE); # Allow sorting on the column #$slist->get_model->set_sort_column_id(0); #Gtk2::TreeSortable::set_sort_column_id($slist, 0, undef); $scwin->add ($slist); my $vbox = Gtk2::VBox->new (0, 6); $hbox->pack_start($vbox, 0, 1, 0); # finally, a button to end it all my $btn = Gtk2::Button->new_from_stock ('gtk-quit'); $btn->signal_connect (clicked => sub { Gtk2->main_quit; }); $vbox->pack_end($btn, 0, 1, 0); $win->show_all; Gtk2->main;

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: Insert checkbutton into MListbox
by Anonymous Monk on Feb 02, 2012 at 16:12 UTC
Re: Insert checkbutton into MListbox
by Anonymous Monk on Feb 03, 2012 at 05:08 UTC

    Thanks a lot. It helped. Especially the first document link whic clearly states about its limitaion.

Re: Insert checkbutton into MListbox
by chessgui (Scribe) on Feb 03, 2012 at 17:37 UTC
    use Tk; use Tk::MListbox; use File::stat; my $dir_name=0; my $dir_mode=3; my $dir_prefix=' <'; my $dir_postfix='>'; my $file_prefix=' --> '; my $file_postfix=''; my $mw=new MainWindow; $mw->geometry('+30+30'); my $control=$mw->Frame->pack(-expand=>1,-fill=>'x'); $control->Button( -text=>'Exit', -width=>30, -background=>'#ffafaf', -activebackground=>'#ff7f7f', -command=>sub{exit} )->pack(-side=>'right'); my $control1=$control->Frame->pack(-side=>'right',-expand=>1,-fill=>'x +'); my $control2=$control1->Frame->pack(-anchor=>'center'); $control2->Button( -width=>10, -text=>'Up', -command=>sub{directory('..')} )->pack(-side=>'left'); $control2->Button( -width=>10, -text=>'<', -command=>sub{my_move(-1)} )->pack(-side=>'left'); $control2->Button( -width=>10, -text=>'>', -command=>sub{my_move(1)} )->pack(-side=>'left'); my $go_button=$control2->Button( -width=>10, -text=>'Go', -command=>\&openFileOrDir )->pack(-side=>'left'); my $ml = $mw->Scrolled('MListbox', -height=>20, -width=>685, -font=>[-family=>'Courier',-size=>10], -scrollbars => 'e', -selectmode => 'browse', -columns=> [ [-text=>'Name',-textwidth=>'30',-bg=>'#ffafaf',-fg=>'#000000'] +, [-text=>'Size',-textwidth=>'20',-bg=>'#afffaf',-fg=>'#000000'] +, [-text=>'Modt',-textwidth=>'21',-bg=>'#ffafaf',-fg=>'#000000'] +, [-text=>'Mode',-textwidth=>'12',-bg=>'#afffaf',-fg=>'#000000', +-comparecmd => sub {$_[1] cmp $_[0]}] ] )->pack; my $text=$mw->Scrolled('Text', -scrollbars=>'se', -width=>97, -height=>15 )->pack; $ml->bindRows("<Double-Button-1>", \&openFileOrDir); $ml->bindRows('<ButtonRelease-1>', sub { my ($w, $infoHR) = @_; view_file($infoHR->{-row}); } ); directory('.'); MainLoop; sub directory { my ($dir) = @_; my ($par_attr); chdir($dir); my $pwd = `echo %cd%`; chomp $pwd; $mw->title ("Directory: $pwd"); # Empty $ml $ml->delete(0,'end'); opendir (DIR, ".") or die "Cannot open '.': $!\n"; foreach my $name (readdir(DIR)) { my $st = stat($name); my $mode = $st->mode; my $type = do { if (-l $name) { $mode = 0777; 'l'; } elsif (-f $name) { '-'; } elsif (-d $name) { 'd'; } elsif (-p $name) { 'p'; } elsif (-b $name) { 'b'; } elsif (-c $name) { 'c'; } else { ' '; }}; my $mtime = $st->mtime; $mtime=' '.my_time($mtime); $mode = " $type" . convMode ($st->mode); if($type eq 'd') { $name="$dir_prefix$name$dir_postfix"; } else { $name="$file_prefix$name$file_postfix"; } my $size=' '.my_size($st->size); my @row=[$name,$size,$mtime,$mode]; if(($name ne "$dir_prefix.$dir_postfix")&&($name ne "$dir_prefix.. +$dir_postfix")) { $ml->insert('end',@row); } if($name eq "$dir_prefix..$dir_postfix") { @par_attr=@row; } } $ml->sort(0,(3,0,2,1)); print "pwd:$pwd\n"; if(!($pwd=~/:\\$/)) { $ml->insert (0, @par_attr ); } $ml->update; } sub my_time { my $mtime=shift; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($m +time); $mtime=sprintf("%02d.%02d.%02d %02d:%02d:%02d",$year+1900,$mon+1,$ +mday,$hour,$min,$sec); return $mtime; } sub convMode { my $mode = shift; my $result = ''; $result .= ($mode & 0400) ? 'r' : '-'; $result .= ($mode & 0200) ? 'w' : '-'; if ($mode & 0100) { if ($mode & 04000) { $result .= 's'; } else { $result .= 'x'; } } else { $result .= '-'; } $result .= ($mode & 040) ? 'r' : '-'; $result .= ($mode & 020) ? 'w' : '-'; if ($mode & 010) { if ($mode & 02000) { if (($mode & 02010) || ($mode & 02030) || ($mode & 02050) || ($mode & 02070)) { $result .= 's'; } else { $result .= 'l'; } } else { $result .= 'x'; } } else { $result .= '-'; } $result .= ($mode & 04) ? 'r' : '-'; $result .= ($mode & 02) ? 'w' : '-'; $result .= ($mode & 01) ? 'x' : '-'; return $result; } sub openFileOrDir { my @sel = $ml->curselection; if (@sel == 1) { my $name = ($ml->getRow($sel[0]))[$dir_name]; my $mode = ($ml->getRow($sel[0]))[$dir_mode]; if ($mode =~ m/^ d/) { # Directory? $name=~/^$dir_prefix(.*)$dir_postfix/; directory ($1); } } } sub view_file { my $row=shift; if(is_dir($row)) { $go_button->configure(-state=>'normal'); my_put(''); } else { $go_button->configure(-state=>'disabled'); my $name=get_name($row); view_file_inner($name); } } sub get_name { my $row=shift; my $name=($ml->getRow($row))[$dir_name]; $name=~/^$file_prefix(.*)/; $name=$1; return $name; } sub is_dir { my $row=shift; my $name=($ml->getRow($row))[$dir_name]; return 1 if($name=~/</); return 0; } sub view_file_inner { my $file=shift; if($file=~/\.pl$|\.bat|\.pm|\.txt|\.text/) { open FILE,$file; my $pl=join('',<FILE>); close FILE; my_put("Full name: $file\n\n$pl"); } else { my_put("Full name: $file\n\nThis file can't be viewed.\n"); } } sub my_put { my $what=shift; $what=~s/\r//g; $text->delete('1.0','end'); $text->insert('1.0',$what); } sub my_size { my $what=shift; return '' unless $what; return sprintf "%10d %7s",$what,my_size_inner($what); } sub my_size_inner { my $what=shift; return '' unless $what; return "$what b" if $what<1000; return sprintf("%.0f",$what/1000).' k' if $what<1000000; return sprintf("%.0f",$what/1000000).' M'; } sub my_move { my $dir=shift; my $cur=($ml->curselection)[0]; my $size=$ml->size; print "old $dir $cur $size\n"; $cur+=$dir; $cur=$size-1 if $cur<0; $cur=0 if $cur>=$size; print "new $dir $cur $size\n"; $ml->selectionClear(0,'end'); $ml->selectionSet($cur); $ml->see($cur); view_file($cur); }

      Hi , Thanks for your reply. Actually my requirement is to insert some checkbuttons into Listbox or MListbox. There will also be two buttons (up and down) beside the listbox which will let me move up/down any selection in the listbox. Suppose, I have "job" "status" , "time", "result" as checkbuttons in the listbox/mlistbox. I need to select/de-select them (which will happen if they are checkbuttons, no issues) and then by pressing the buttons I can re-order the appearence of checkbuttons in the listbox and finally collect the order of their appearence. That means lets say the above order after pressing up/down on any selection will become "time", "result","job" "status" I have already known MListbox does not support packing widgets in them. Listbox is also not working when I am doing the following thing. I have created a composite widget actually with Listbox and so used Subwidget

      my $listbox = $self->Subwidget('listbox'); my $style = $self->ItemStyle('window'); my $btn = $listbox->Checkbutton(-text => 'state'); $listbox->insert('end', [-itemtype => 'window', -widget => $btn, - +style => $style]);

      The above code is giving error when I am doing $style = $listbox->ItemStyle('window'). Now I am trying with TList (tix widget). I am able to pack checkbuttons but moving them up and down is not able to do. Please help. Actually, I already have a main window where I have all the above mentioned items as columns. I want to serve a capability to the user of my tool so that they can hide/show columns in that main window and also can change the order of their appearence. For that, I need a dialog which will provide this listbox facility. Upon selection/deselection of checkbuttons and change of their order in the listbox, I will determine which all column to show in the main window and their order as well. You can also suggest any alternative idea, say with NumEntry. But numEntry will set a number to them by which I will get the order the user wants. But what about hide/show then ? I hope I have explained my requirement better. Thanks .

        Forget list widgets. Use a Text widget. Pack all the buttons in it that you need. Even add buttons to move items up and down the list (in each row you would have a Checkbutton, an 'UP' Button and a 'DOWN' Button. When the user chooses to move an element a row up or down just create the Text widget from scratch again with the Buttons in the new order and redisplay it.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://951421]
Approved by Corion
[karlgoethebier]: choroba: This: https://www. ???
[karlgoethebier]: I get "You are using an outdated version of Internet Explorer. For a faster, safer browsing experienceUpgrade" Ouch! i got safari...
[karlgoethebier]: ...well, outdated

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2017-11-19 12:46 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (280 votes). Check out past polls.