#!/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]

In reply to Re^2: Perl Tk Gang together two Scrolled Panes by ashervin
in thread Perl Tk Gang together two Scrolled Panes by ashervin

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.