Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
go ahead... be a heretic
 
PerlMonks  

Re: Insert checkbutton into MListbox

by chessgui (Scribe)
on Feb 03, 2012 at 17:37 UTC ( #951689=note: print w/ replies, xml ) Need Help??


in reply to Insert checkbutton into MListbox

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); }


Comment on Re: Insert checkbutton into MListbox
Download Code
Re^2: Insert checkbutton into MListbox
by ghosh123 (Scribe) on Feb 06, 2012 at 09:23 UTC

    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.

        Can you please explain the answer a bit more. "Pack all the buttons in it" ... here button means checkbutton ...right ? And you want me to create a 'up' and 'down' button beside each of those checkbuttons in each row ? Currently I am running the following code. If you just look at it,it will help you to explain me a bit elaborately

        #!/usr/bin/perl use strict; use warnings; use Tk; use Tk::TList; use Tk::ItemStyle; my $mw = MainWindow->new(); my $style = $mw->ItemStyle('window'); my $tl = $mw->Scrolled("TList", -scrollbars => "osoe")->pack(-side=>'l +eft', -fill => 'y'); $mw->Button(-text => "UP", -command => \&press_func_up)->pack(); $mw->Button(-text => "DOWN", -command => \&press_func_dwn)->pack(); foreach my $item ("State" , "Dependency", "CalcTime", "Result") { my $btn = $tl->Checkbutton(-text => $item); $tl->insert('end', -itemtype => 'window', -style => $style, -widge +t => $btn); } sub press_func_up { # Move items up } sub press_func_dwn { # Move items up } MainLoop;

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2014-04-18 07:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (463 votes), past polls