Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

Re: Auto-adjust row height to line wrap in Tk-Tablematrix

by elef (Friar)
on Feb 21, 2013 at 18:08 UTC ( #1019993=note: print w/replies, xml ) Need Help??

in reply to Auto-adjust row height to line wrap in Tk-Tablematrix

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)(=/%!+"'§΄&#729;`&#731;°^&# +711;~ well, this cell contains quite a lot of text so I'm expecting it will +be wrapped lalalaια&#369;ϊ&#337;νσόΦ)(=/%!+"'§΄&#729;`&#731;°^&#71 +1;~

Replies are listed 'Best First'.
Re^2: Auto-adjust row height to line wrap in Tk-Tablematrix
by Anonymous Monk on Jul 05, 2013 at 18:33 UTC

    I know that the post is a bit old, but I have the following problem. The script works just fine, but if I change the font dimension, it fails. What can I do to have it working even with, let say:

    my $textfont = '-*-Courier-Medium-R-Normal--*-180-*-*-*-*-*-*';

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1019993]
and monks are getting baked in the sun...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2018-06-20 10:09 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (116 votes). Check out past polls.