package Tk::MyLabel;
require Tk::Label;
@ISA = qw(Tk::Label);
Construct Tk::Widget 'MyLabel';

#公開したいサブルーチン
#@EXPORT = qw();

use strict;
#use base  qw(Tk::Widget);

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

	$cw->SUPER::Populate($args);
return;
#	my $b = $cw->Label();
#	$b->pack(-expand => 1, -fill => 'both');
#	$cw->Advertise('MyLabel', => $b);
#	$cw->ConfigSpecs(DEFAULT => [$b]);
#	$cw->Delegates(DEFAULT => $b);
}

sub ClassInit
{
	my ($class, $mw) = @_;
	return $class;
}

BEGIN {
}

sub new
{
	my $class = shift;
	my ($parent,@args) = @_;
#	print "new: parent=$parent\n";
	my @newargs;
	push(@newargs, $_[0]);
	my $textvar = '';
	my $pTextVar = \$textvar;
	for(my $i = 0 ; $i < @args ; $i += 2) {
#		print "new:arg$i: $args[$i] => $args[$i+1]\n";
		if($args[$i] eq '-text') {
			$$pTextVar = $args[$i+1];
			next;
		}
		if($args[$i] eq '-textvariable') {
			$pTextVar = $args[$i+1];
			next;
		}
		push(@newargs, $args[$i]);
		push(@newargs, $args[$i+1]);
	}
	my $self = Tk::Label->new(@newargs);
	$self->{pTextVariable} = $pTextVar;
	$self->configure( -textvariable => $self->{pTextVariable} );

	return bless $self, ref($class) || $class;
}

sub DESTROY
{
	my $this = shift;
	$this->SUPER::DESTROY(@_);
}

sub SetTitle
{
	my ($this, $title) = @_;
	my $p = $this->{pTextVariable};
	return $$p = $title;
}

sub GetTitle
{
	my ($this) = @_;
	my $p = $this->{pTextVariable};
	return $$p;
}

sub SetText
{
	my ($this, $title) = @_;
	return $this->SetTitle($title);
}

sub GetText
{
	my ($this) = @_;
	return $this->GetTitle();
}

1;