What are you actually trying to do with the header? Drag columns perhaps?

Re^2: Tk::Hlist header callbacks

carno

created: 2006-09-04 19:03:01

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

I want to use it to set the column to use for the sort order of a MySQL query. Other ideas come to mind though - moving the columns as you suggest, popup display settings for the columns, etc.

jdtoronto

HList headers cannot receive events in a useful way and there are no HList-specific callbacks that will do what you are looking for.

What is possible is to embed a widget within each header (though to be excruciatingly accurate it actually floats above the header), and bind to the embedded widgets -- not the header. You might also take a look at Tk::ResizeButton, which can be found on CPAN.

The following example was culled from one of my posts from the c.l.p.tk archives from back in 2001. I'm certain that there are other related examples to be found there as well.:

use Tk;
use Tk::HList;

my $mw = new MainWindow;

my $hl = $mw->Scrolled('HList',
  -scrollbars => 'os',
  -background => 'white',
  -columns => 4,
  -header => 1,
  -width => 40,
  -height => 5
)->pack;

my $bgcolor = "bisque";
foreach my $column (0 .. 3) {

  ## Create the Clickable Header
  my $b =  $hl->Button(
    -background => $bgcolor,
    -anchor => 'center',
    -text => "Header$column",
    -command => sub {
      print "You pressed Header $column\n";
    }
  );

  $hl->headerCreate( $column,
    -itemtype => 'window',
    -borderwidth      => -2,
    -headerbackground => $bgcolor,
    -widget => $b
  );

}

MainLoop;

Some more comments from the same post:

Note the borderwidth of -2 for the headerCreate method. This is something I found by trial and error. I did not want there to be a borderwidth on both the button AND the header that HList creates, but if you don't set this value, then you will get both.

Also note that you are almost guaranteed to have a small section of space left after the the last header. I know of at least one way to "sort of" get around this. You can add an extra column in the HList widget that you don't use. It looks as though there is an empty header (unclickable of course) which fills up the remaining space. This is a similar approach that I've seen in some Windows GUI's.

You might also try resizing columns if the detect that the widget has been resized (bind to configure event, and compare reqWith reqHeight, etc), then adjust column sizes to whatever is appropriate.

In the past, what I have done is to embed a Frame widget which had "handles" (another frame widget) that I could use to enlarge/shrink column widths. A user would drag the handle causing a floating frame above the HList to show where the new column should be, and when the mouse was released, the column would be resized.

There are plenty of things you can use HList for, but I would be caution you against using very large datasets. I started noticing slowness at 10K or more cells when updating sorts. For large data sets, I'd recommend Tk::TableMatrix. Similar techniques can be applied to it.

HTH,

#!/usr/bin/perl
use strict;
use Tk;
use Tk::HList;
# use MeM;  #for tracking memory increases


my $mw = MainWindow->new();

#create some sample data
my %data;

foreach (0..100) {
      $data{$_}{'name'} = 'name'.$_;
      $data{$_}{'id'} =   rand(time);
      $data{$_}{'priority'} =  int rand 50;
}
#get random list of keys
my @keys = keys %data; 

#################

my $h = $mw->Scrolled( 'HList', 
                       -header => 1,
                       -columns => 3,
                       -width => 40,
                       -height => 40,
                       -takefocus => 1,
                       -background => 'steelblue',
	               -foreground =>'snow',
		       -selectmode => 'single',
                       -selectforeground => 'pink',
                       -selectbackground => 'black',
                #       -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '   Name  ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
			-relief => 'raised');

$h->header('create', 1, -text => '      ID      ',
                        -borderwidth => 3,
                        -headerbackground => 'lightsteelblue',
                	-relief => 'raised');

$h->header('create', 2, -text => '  Priority  ',
                        -borderwidth => 3,
                        -headerbackground => 'lightgreen',
                	-relief => 'raised');


foreach (@keys) {
     my $e = $h->addchild(""); #will add at end
        
     $h->itemCreate ($e, 0,
           -itemtype => 'text',
           -text => $data{$_}{'name'},
            );
					    
     $h->itemCreate($e, 1,
           -itemtype => 'text',
           -text => $data{$_}{'id'},
         );

     $h->itemCreate($e, 2,
           -itemtype => 'text',
           -text => $data{$_}{'priority'},
         );

}

my $button = $mw->Button(-text => 'exit',
                         -command => sub{exit})->pack;

my $sortid = $mw->Button(-text => 'Sort by Id',
                         -command => [\&sort_me,1] )->pack;

my $sortpriority = $mw->Button(-text => 'Sort by Priority',
                         -command => [\&sort_me,2] )->pack;


MainLoop;
#########################################################

sub sort_me{
  my $col = shift;

  my @entries = $h->info('children');
  my @to_be_sorted =();

 foreach my $entry(@entries){
           push @to_be_sorted,
	   [ $h->itemCget($entry,0,'text'),
	     $h->itemCget($entry,1,'text'),
	     $h->itemCget($entry,2,'text'),
	   ];
           }

  my @sorted = sort{ $a->[$col] cmp $b->[$col]  || #primary sort ascii
                     $a->[1] <=> $b->[1]           #secondary sort numeric
                       } @to_be_sorted;
		    
my $entry = 0;
  foreach my $aref (@sorted){
#    print $aref->[0],' ',$aref->[1],' ',$aref->[1],"\n";
    $h->itemConfigure( $entry, 0, 'text' => $aref->[0] );  
    $h->itemConfigure( $entry, 1, 'text' => $aref->[1] ); 
    $h->itemConfigure( $entry, 2, 'text' => $aref->[2] ); 
    $entry++;
  }

$mw->update;
}

Re^2: Tk::Hlist header callbacks

Anonymous Monk

created: 2006-09-05 23:31:19

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

Many thanks for the suggestions. It will take me a few days to try some of this out (other pressing obligations), but from here it looks like I will have more than one way to do it... I'll post more later after I get to do some testing.

Re^3: Tk::Hlist header callbacks

Anonymous Monk

created: 2006-09-09 13:49:26

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

I finally got a chance to try these out. The button widget in the header and surrounding discoveries (like padx -2 and adding the extra column) look like they'll do what I need. I won't be using Perl for the sort - I'll just resubmit a new Mysql query in this case because I have a small database and the result set is limited to 1000.

Tk::DBI::Table looks like it would work for most things and I'll definitely be using it in the future, but it didn't handle my hierarchy quite the way I needed - probably could be solved with some mysql code to set up a unique index field, but I'm not yet familiar enough with mysql to do that.

Many thanks again for the suggestions.