view release on metacpan or  search on metacpan

lib/Tk/Statusbox.pm  view on Meta::CPAN

######################################## SOH ###########################################
## Function : Additional Tk Class for a (colored) status display
##
## Copyright (c) 2002 Michael Krause. All rights reserved.
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##
## History  : V1.0	01-Oct-2002 	Class released. MK
##            V1.01 05-Dec-2002 	Bugfix/Enhancement for Set-Reset '-variable'
##
######################################## EOH ###########################################
package Tk::Statusbox;

##############################################
### Use
##############################################
use Tk;
use Tk::Button;
use Tk::Frame;

use strict;
use Carp;

use vars qw ($VERSION);
$VERSION = '1.00';

use base qw (Tk::Derived Tk::Frame);

########################################################################
Tk::Widget->Construct ('Statusbox');

#---------------------------------------------
sub ClassInit {
	my ($class, $window) = (@_);

	$class->SUPER::ClassInit($window);
}

#---------------------------------------------
sub Populate {
	my ($this, $args) = @_;

	# Retrieve standard background
	if (defined ($args->{-bg})) {
		$args->{-background} = $args->{-bg};
	}
	my $common_background = (defined($args->{-background})) ? 
										$args->{-background} :
										$this->cget ('-background');
										
	# Create a Closure for saving the current value,
	# if there is no variable spec'd
	unless (defined $args->{-variable}) {
		my $gen = $common_background;
		my $var = \$gen;
		$args->{-variable} = $var;
	}

	$this->SUPER::Populate ($args);
	

	#Widget Creation
	my $canvas = $this->Canvas(
		-highlightthickness => '0',
		-relief => 'flat',
		-borderwidth => '0',
	)->pack(
    	-fill => 'both',
    	-expand => '1',
		-anchor => 'center',
	);

	$this->Advertise( 'canvas' => $canvas );
	$this->ConfigSpecs(
    	-background				=> [['DESCENDANTS'], 'background', 'Background', 'white'],
    	-foreground				=> [['SELF', 'PASSIVE'], 'foreground', 'Foreground', 'black'],
    	-activebackground		=> [['SELF', 'DESCENDANTS', 'PASSIVE'], 'activebackground', 'ActiveBackground', '#ececec'],
    	-disabledforeground 	=> [['SELF', 'DESCENDANTS', 'PASSIVE'], 'disabledForeground', 'DisabledForeground', '#a3a3a3'],
    	-disabledbackground 	=> [['SELF', 'DESCENDANTS', 'PASSIVE'], 'disabledBackground', 'DisabledBackground', '#AE00B200C300'],
    	-borderwidth			=> [['SELF', 'PASSIVE'], 'borderwidth', 'BorderWidth', 2],
    	-color					=> [['SELF', 'PASSIVE'], 'color', 'Color', 'red'],
    	-relief					=> [['SELF', 'PASSIVE'], 'relief', 'Relief', 'groove'],
    	-height					=> ['DESCENDANTS', 'height', 'Height', 15],
    	-width					=> ['DESCENDANTS', 'width', 'Width', 15],
    	-flashintervall			=> [['SELF', 'PASSIVE'], 'flashintervall', 'FlashIntervall', 500],
    	-command 				=> ['CALLBACK',undef,undef, undef],
    	-variable 				=> ['METHOD', 'variable', 'Variable', undef],