package Tk::MyScale;
require Tk::Scale;
@ISA = qw(Tk::Scale);
Construct Tk::Widget 'MyScale';

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

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

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

	$cw->SUPER::Populate($args);
	return;
}

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

sub new
{
	my $class = shift;
	my ($parent,@args) = @_;
#	print "new: parent=$parent\n";

	my @newargs;
	push(@newargs, $_[0]);
	my $Variable = '';
	for(my $i = 0 ; $i < @args ; $i += 2) {
#		print "new:arg$i: $args[$i] => $args[$i+1]\n";
		if($args[$i] eq '-variable') {
			$Variable = $args[$i+1];
			next;
		}
		push(@newargs, $args[$i]);
		push(@newargs, $args[$i+1]);
	}
	my $self = Tk::Scale->new(@newargs);
	$self->{'variable'} = \$Variable;
	$self->configure( -variable => $self->{'variable'} );

	my $this = bless $self, ref($class) || $class;
	$this->SetTitle($Variable);
	return $this;
}

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

sub SetTitle
{
	my ($this, $title) = @_;
	return ${$this->{'variable'}} unless(defined $title);
	return ${$this->{'variable'}} = $title;
}

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

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

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

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

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

1;