Here's the code I came up with for auto-adjusting row height in case anyone needs it. It sets the height of each row to accommodate the tallest cell in the row, based on the width of each column and the content of each cell. Of course it's an approximation so it's occasionally off by one line. You can tune it by changing the -8 value. It's reasonably fast, it reflows 5000 rows in about 2 sec.
On another note, anyone know how I can automatically call the
setheight sub when the width of a column is changed (by drag and drop)? If I could detect the change of the width I wouldn't need a separate button for this.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Dialog;
use Tk::TableMatrix;
use utf8;
sub setheight;
my $mw = MainWindow->new;
$mw->minsize(800, 500); # minimum size of main window in pixels
+
my $textfont = '-*-Courier-Medium-R-Normal--*-140-*-*-*-*-*-*';
my $arrayVar = {};
while (<DATA>) {
my $i = $. - 1;
/^([^\t]*)\t([^\t]*)/;
$arrayVar->{"$i,0"} = "$1";
$arrayVar->{"$i,1"} = "$2";
}
my $rows = $.;
# print "\nrows: $rows\n";
my $cols = 2; # number of columns
my $t = $mw->Scrolled('TableMatrix',
-scrollbars => "osoe",
-font => $textfont,
-resizeborders => 'col', # none, col, row
-bordercursor => "sb_h_double_arrow",
-rows => $rows,
-cols => $cols,
-wrap => 1,
-justify => 'left', # this only affects mul
+tiline cells
-anchor => 'nw', # this aligns text to
+the top left
# -rowheight => 1,
-colwidth =>-400,
-variable => $arrayVar,
# -colstretchmode => 'all',
)->pack(-expand => 1, -fill => 'both');
setheight; # initial height adjustment; height will be readjusted l
+ater when necessary by calling the same sub
my $buttexit = $mw->Button( -text => "Exit", -command => sub{ $mw->des
+troy});
my $buttheight = $mw->Button( -text => "Set height", -command => sub {
+setheight;});
$buttheight->pack();
$buttexit->pack();
$buttexit->focus( -force );
# my $cursorpos = $t->icursor();
# my $activeindex = $t->index('active');
# my $activecont = $t->get('active');
Tk::MainLoop;
sub setheight {
for my $i (0 .. $rows - 1) {
# print "\n\nrow $i";
for my $col (0 .. $cols - 1) {
$t->activate("$i,$col");
my $activecont = $t->get('active');
# print "\n$i,$col";
my $charcount = length($activecont);
# print " length: $charcount";
my $width = $t->colWidth($col,) / -8; # approx width in ch
+aracters
my $reqheight = int(length($activecont) / $width) + 1;
# print ", required height: $reqheight";
my $currheight = $t->rowHeight($i);
$t->rowHeight($i, $reqheight) if ( ($col == 0) or ($reqhei
+ght > $currheight)); # set row height for the height of the tallest c
+ell in the row
}
}
}
__DATA__
this is a relatively long string that will probably end up displaye
+d on two lines if the window isn't wide enough this is a relatively l
+ong string that will probably end up displayed on two lines if the wi
+ndow isn't wide enough
this is not that short, eitherrr lalala)(=/%!+"'§΄˙`˛°^&#
+711;~
well, this cell contains quite a lot of text so I'm expecting it will
+be wrapped lalalaιαűϊőνσόΦ)(=/%!+"'§΄˙`˛°^G
+1;~
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.