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