ashervin has asked for the wisdom of the Perl Monks concerning the following question:

I have a pipe delimited file containing lines consisting of various record types. The number of fields in these records are variable. There can be up to 9 different record types. The file begins with lines consisting of the header data for the record types. I currently can view this data within Excel, but would like to have a Perl Tk application that mimics Excel's "Freeze Row" feature.

I have settled on 2 Scrolled Panes and grid layout to accomplish this. Using Frames, I am able to equate the grid cell widths in the header and data frames using gridColumnconfigure(). But I cannot scroll the data using frames. Calling $mw->idletasks was the trick that allowed this to work.

Using Panes, this does not work -- the widths of the cells do not align (lines 75-90 below). Also, lines 25 - 27 do not appear to gang the horizontal slider bars together. Sliding the data frame x scrollbar has no impact on the header frame. What gives, mon friar? 

  1 #!/usr/bin/perl --
  2 
  3 use warnings;
  4 use strict;
  5 use Tk;
  6 
  7 require Tk::Pane;
  8 
  9 my $mw = MainWindow->new();
 10 $mw->geometry("1400x900");
 11 
 12 #my $mainFrame = $mw->Frame();
 13 
 14 my $headFrame = $mw->Scrolled('Pane',
 15     -scrollbars => 'se',
 16     -height=>30,
 17     -width=>1300,
 18     -bg=>'orange')->grid( -row => 0, -column => 0);
 19 my $dataFrame = $mw->Scrolled('Pane', 
 20     -scrollbars => 'se', 
 21     -height=>700, 
 22     -width=>1300, 
 23     -bg=>'gray')->grid( -row => 4, -column => 0);
 24 
 25 my $horiz =  $dataFrame->Subwidget('xscrollbar');
 26 $horiz->configure(-command => 
 27     sub { $dataFrame->xview(@_); $dataFrame->xview(@_) });
 28 
 29 open my $dataFH, "<", $ARGV[0] or die "Could not open $ARGV[0]";
 30 my $row = 0;
 31 my $hRow = 0;
 32 while(!eof $dataFH)
 33 {
 34     my $data=readline($dataFH);
 35     my @dataArr = split '\|', $data;
 36     my $column = 0;
 37     my $bg='gray'; 
 38     if($dataArr[0] =~ m/^Record/)
 39     {   
 40         $bg='orange';
 41         foreach my $field (@dataArr)
 42         {   
 43             my $label = $headFrame->Label(-height=>2,
 44                 -bg=>$bg, 
 45                 -fg=>'black',  
 46                 -text => $field, 
 47                 -relief => 'ridge');
 48             $label->grid( -sticky=> 'ew',
 49                 -row => $hRow, 
 50                 -column => $column++);
 51         }
 52         $hRow++;
 53     }
 54     else
 55     {   
 56         foreach my $field (@dataArr)
 57         {   
 58             my $label = $dataFrame->Label(-height=>2,
 59                 -bg=>$bg, 
 60                 -fg=>'black',  
 61                 -text => $field, 
 62                 -relief => 'ridge');
 63             $label->grid( -sticky=> 'ew',
 64                 -row => $row, 
 65                 -column => $column++);
 66         }
 67         $row += 1;
 68     }
 69 }
 70 $mw->idletasks;
 71 
 72 my ($columns, $rows) = $dataFrame->gridSize();
 73 
 74 my $cnt=0; 
 75 while($cnt < $columns)
 76 {
 77     my ($arg1, $arg2, $width, $arg4) =
 78         $dataFrame->gridBbox($cnt, 4);
 79     my( $arg1a, $arg2a, $hWidth, $arg4a) =
 80         $headFrame->gridBbox($cnt, 0);
 81     if($hWidth > $width)
 82     {
 83         $dataFrame->gridColumnconfigure($cnt, -minsize=>$hWidth);
 84     }
 85     else
 86     {
 87         $headFrame->gridColumnconfigure($cnt, -minsize=>$width);
 88     }
 89     $cnt++;
 90 }
 91 
 92 $mw->MainLoop;

[download]

This is cygwin perl -- perl5 (revision 5 version 22 subversion 3). My company has its own distro and has host machines locked down.

Replies are listed 'Best First'.
Re: Perl Tk Gang together two Scrolled Panes
by tybalt89 (Monsignor) on Nov 29, 2018 at 16:19 UTC

    Ganged scrolling problem. 

    $horiz->configure(-command => 
  sub { $dataFrame->xview(@_); $dataFrame->xview(@_) });

    [download]

    should be 

    $horiz->configure(-command => 
  sub { $headFrame->xview(@_); $dataFrame->xview(@_) });

    [download]
[reply]
[d/l]
[select]

      Thanks tybalt89! now I am ganged, with still misaligned data.

      There is another minor snit, but the last column on every row ends up with the data not centered in the grid. That is why I ended up going with a height of 2 for the grid. Interestingly, when I push another string on the readline array, the OLD last item is still psuedo-'n', but the added last item on the row is fine.

[reply]

        You are missing a "chomp" on your input.

[reply]
Re: Perl Tk Gang together two Scrolled Panes
by tybalt89 (Monsignor) on Nov 29, 2018 at 17:54 UTC

    Just a few tweaks here and there :)

    You will have to change back to your file input. 

    #!/usr/bin/perl

# https://perlmonks.org/?node_id=1226501

use warnings;
use strict;
use Tk;
use List::Util qw( max );

require Tk::Pane;

my $mw = MainWindow->new();
$mw->geometry("1400x900+0+40");

my $headFrame = $mw->Scrolled('Pane',
  -scrollbars => 'se',
  -height=>60,
  -width=>1300,
  -bg=>'orange')->grid( -row => 0, -column => 0);
my $dataFrame = $mw->Scrolled('Pane', 
  -scrollbars => 'se', 
  -height=>700, 
  -width=>1300, 
  -bg=>'gray')->grid( -row => 4, -column => 0);

my $horiz =  $dataFrame->Subwidget('xscrollbar');
$horiz->configure(-command => 
  sub { $headFrame->xview(@_); $dataFrame->xview(@_) });

#open my $dataFH, "<", $ARGV[0] or die "Could not open $ARGV[0]";
my $row = 0;
my $hRow = 0;
#while(!eof $dataFH)
while( <DATA> )
  {
  #my $data=readline($dataFH);
  chomp;
  my $data = $_;
  my @dataArr = split '\|', $data;
  my $column = 0;
  my $bg='gray'; 
  if($dataArr[0] =~ m/^Record/)
    {   
    $bg='orange';
    foreach my $field (@dataArr)
      {   
      my $label = $headFrame->Label(-height=>2,
        -bg=>$bg, 
        -fg=>'black',  
        -text => $field, 
        -relief => 'ridge');
      $label->grid( -sticky=> 'ew',
        -row => $hRow, 
        -column => $column++);
      }
    $hRow++;
    }
  else
    {   
    foreach my $field (@dataArr)
      {   
      my $label = $dataFrame->Label(-height=>2,
        -bg=>$bg, 
        -fg=>'black',  
        -text => $field, 
        -relief => 'ridge');
      $label->grid( -sticky=> 'ew',
        -row => $row, 
        -column => $column++);
      }
    $row += 1;
    }
  }
$mw->idletasks;

my ($columns, $rows) = $dataFrame->Subwidget('pane')->gridSize();

for my $cnt ( 0 .. $columns - 1 )
  {
  my ($arg1, $arg2, $width, $arg4) =
    $dataFrame->Subwidget('pane')->gridBbox($cnt, 0);
  my( $arg1a, $arg2a, $hWidth, $arg4a) =
    $headFrame->Subwidget('pane')->gridBbox($cnt, 0);
  my $maxwidth = 6 + max($hWidth, $width);
  $headFrame->Subwidget('pane')->gridColumnconfigure($cnt, -minsize=>$
+maxwidth);
  $dataFrame->Subwidget('pane')->gridColumnconfigure($cnt, -minsize=>$
+maxwidth);
  }

$mw->MainLoop;

__DATA__
Record|one|two|three|one|two|three|one|two|three|one|two|three|one|two
+|three|one|two|three|one|two|three|one|two|three|one|two|three|one|tw
+o|three|one|two|three|one|two|three|one|two|three|one|two|three|one|t
+wo|three|one|two|three|one|two|three|one|two|three
dataforrecord|one|two|three|one|two|three|one|two|three|one|two|three|
+one|two|three|one|two|three|one|two|three|one|two|three|one|two|three
+|one|two|three|one|two|three|one|two|three|one|two|three|one|two|thre
+e|one|two|three|one|two|three|one|two|three|one|two|three

    [download]
[reply]
[d/l]
Re: Perl Tk Gang together two Scrolled Panes
by zentara (Cardinal) on Nov 29, 2018 at 14:48 UTC
    It might help if you removed the line numbers from your code example, so others can try running your code without too much editing.
    I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
      #!/usr/bin/perl --

use warnings;
use strict;
use Tk;

require Tk::Pane;

my $mw = MainWindow->new();
$mw->geometry("1400x900");

#my $mainFrame = $mw->Frame();

my $headFrame = $mw->Scrolled('Pane',
    -scrollbars => 'se',
    -height=>30,
    -width=>1300,
    -bg=>'orange')->grid( -row => 0, -column => 0);
my $dataFrame = $mw->Scrolled('Pane',
    -scrollbars => 'se',
    -height=>700,
    -width=>1300,
    -bg=>'gray')->grid( -row => 4, -column => 0);

my $horiz =  $dataFrame->Subwidget('xscrollbar');
$horiz->configure(-command =>
    sub { $dataFrame->xview(@_); $dataFrame->xview(@_) });

open my $dataFH, "<", $ARGV[0] or die "Could not open $ARGV[0]";
my $row = 0;
my $hRow = 0;
while(!eof $dataFH)
{
    my $data=readline($dataFH);
    my @dataArr = split '\|', $data;
    my $column = 0;
    my $bg='gray';
    if($dataArr[0] =~ m/^Record/)
    {
        $bg='orange';
        foreach my $field (@dataArr)
        {
            my $label = $headFrame->Label(-height=>2,
                -bg=>$bg,
                -fg=>'black',
                -text => $field,
                -relief => 'ridge');
            $label->grid( -sticky=> 'ew',
                -row => $hRow,
                -column => $column++);
        }
        $hRow++;
    }
    else
    {
        foreach my $field (@dataArr)
        {
            my $label = $dataFrame->Label(-height=>2,
                -bg=>$bg,
                -fg=>'black',
                -text => $field,
                -relief => 'ridge');
            $label->grid( -sticky=> 'ew',
                -row => $row,
                -column => $column++);
        }
        $row += 1;
    }
}
$mw->idletasks;

my ($columns, $rows) = $dataFrame->gridSize();

my $cnt=0;
while($cnt < $columns)
{
    my ($arg1, $arg2, $width, $arg4) =
        $dataFrame->gridBbox($cnt, 4);
    my( $arg1a, $arg2a, $hWidth, $arg4a) =
        $headFrame->gridBbox($cnt, 0);
    if($hWidth > $width)
    {
        $dataFrame->gridColumnconfigure($cnt, -minsize=>$hWidth);
    }
    else
    {
        $headFrame->gridColumnconfigure($cnt, -minsize=>$width);
    }
    $cnt++;
}

$mw->MainLoop;

      [download]
[reply]
[d/l]

        Here is some data.

        Record 0|HeaderRegion|HeaderLpar|HeaderDate|ApplInd|FileType

        Record1|Entity|XXXXXXXNumber|XXXXXXXXXXType|XXXXXXXXXCd|Initiator|XXXXXXXXXCd|XXXXXXXXXAmt|XXXXXCd|XXXXXXXXXXXCd|XXXXLimit|XXXXLimit|XXXXXXXXXInd|XXXXXXCd|TimeZone|Year|Month|Day|Hour|Minutes|Seconds|NanoSeconds|BassRsnCd|MachineIdType|MachineId|UserIdType|UserId

        Record 8|EntityCode|TotalDetailRecordCount

        Record 9|RecordCount

        0|NE|9U|20180705|CPUU |

        1|00001|00000077295245|QF|125 |D|O|.0| | |.0|.0| | |DUV|2018|08|07|11|21|56|000000| | | |XXX|XXXXXXX

        1|00001|00237026981728|QF|125 |D|O|.0| | |.0|.0| | |DUV|2018|08|07|12|00|11|000000| | | |XXX|XXXXXXX

        1|00001|00002370951778|QF|125 |D|O|.0| | |.0|.0| | |DUV|2018|08|08|13|09|10|000000| | | |XXX|XXXXXXX

        1|00001|00237028512150|QF|125 |D|O|.0| | |.0|.0| | |DUV|2018|08|08|13|10|37|000000| | | |XXX|XXXXXXX

        1|00001|00237995669646|QF|264 |D|O|.0| | |.0|.0| | |DUV|2018|08|08|14|33|40|000000| | | |XXX|XXXXXXX

        1|00001|00000686096496|QF|125 |D|P|.0| | |.0|.0| | |DUV|2018|08|10|14|33|01|000000| |OC|XXXXXXX | |

        1|00001|00237002888298|QF|300 |D|O|.0| | |.0|.0| | |DUV|2018|08|23|17|19|33|000000| | | |XXX|XXXXXXX

        8|00001|0000000007

        9|0000000070

[reply]

Back to Seekers of Perl Wisdom