view release on metacpan or  search on metacpan

TFrame.pm  view on Meta::CPAN

# $Id: TFrame.pm,v 2.2 2007/12/06 20:09:39 eserte Exp $

package Tk::TFrame;

use Tk;
use strict;
use vars qw($VERSION @ISA);

@ISA = qw(Tk::Derived Tk::Frame);
$VERSION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);

Construct Tk::Widget "TFrame";

sub ClassInit {
    my ($class,$mw) = @_;
    $mw->bind($class,'<Configure>',['layoutRequest']);
    $mw->bind($class,'<FocusIn>',  'NoOp');
    return $class;
}

sub Populate {
    my($frame,$args) = @_;

    $frame->Tk::configure(-borderwidth => 0, -highlightthickness => 0);

    my $border    = $frame->Component(Frame => "border");

    my @label = (
	-padx => 4,
	-pady => 2,
	-borderwidth => 2,
	-relief => 'flat'
    );

    if (exists $args->{'-label'}) {
       if (not ref $args->{'-label'}) {
           $args->{'-label'} = [ -text => $args->{'-label'} ];
       }
       push @label, @{$args->{'-label'}};
    }

    my $label     = $frame->Component(Label => "label",@label);

    my $container = $frame->Component(Frame => "container", -borderwidth => 0);


    $frame->DoWhenIdle(['Manage',$frame]);

    $frame->Default("container" => $container);

    $frame->ConfigSpecs(
	-label => [ 'METHOD', undef, undef, undef],
	-relief => [$border,'relief','Relief','groove'],
	-borderwidth => [$border,'borderwidth','Borderwidth',2],
	-ipadx => [PASSIVE => undef, undef, 0],
	-ipady => [PASSIVE => undef, undef, 0],
    );

    $frame;    
}

sub label {
    my $frame = shift;
    my $v = shift || [];
    my $l = $frame->Subwidget('label');

    $l->configure(@$v);
}