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