Tk::SlideSwitch - a 2 position horizontal or vertical switch.

Tk-SlideSwitch documentation Contained in the Tk-SlideSwitch distribution.

Index

Code Index:

NAME

Top

Tk::SlideSwitch - a 2 position horizontal or vertical switch.

SYNOPSIS

Top

 use Tk::SlideSwitch;

 my $sl = $frame1->SlideSwitch(
     -bg          => 'gray',
     -orient      => 'horizontal',
     -command     => [$self => 'on'],
     -llabel      => [-text => 'OFF', -foreground => 'blue'],
     -rlabel      => [-text => 'ON',  -foreground => 'blue'],
     -troughcolor => 'tan',
 )->pack(qw/-side left -expand 1/);

DESCRIPTION

Top

Tk::SlideSwitch is a Frame based composite mega-widget featuring a binary Scale widget surrounded by two Label widgets. The Scale's value can be either 0 or 1. The Labels are positioned to the left and right of the Scale if its orientation is horizontal, else on the top and bottom of the Scale.

OPTIONS

Top

In addition to all Scale options, the following option/value pairs are also supported:

-llabel

A reference to an array of left (or top) Label configuration options.

-rlabel

A reference to an array of right (or bottom) Label configuration options.

METHODS

Top

There are no special methods.

ADVERTISED WIDGETS

Top

Component subwidgets can be accessed via the Subwidget method. This mega widget has no advertised subwidgets.

EXAMPLE

Top

See Synopsis.

BUGS

Top

This widget uses only the pack geometry manager.

AUTHOR

Top

sol0@Lehigh.EDU

Copyright (C) 2002 - 2003, Steve Lidie. All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

KEYWORDS

Top

SlideSwitch, Scale

Tk-SlideSwitch documentation Contained in the Tk-SlideSwitch distribution. 
$Tk::SlideSwitch::VERSION = '1.1';

package Tk::SlideSwitch;

use Tk;
use Tk::widgets qw/Label Scale/;
use base qw/Tk::Frame/;
use strict;

Construct Tk::Widget 'SlideSwitch';

sub Populate {

    my($self, $args) = @_;

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

    my $ll = $self->Label->pack(-side => 'left');
    my $sl = $self->Scale->pack(-side => 'left');
    my $rl = $self->Label->pack(-side => 'left');

    $self->ConfigSpecs(
        -command      => [$sl,        qw/command      Command            /],  
        -from         => [$sl,        qw/from         From              0/],
        -highlightthickness => [$sl,
            qw/highlightThickness HighlightThickness                    0/],
        -length       => [$sl,        qw/length       Length           30/],
        -llabel       => [qw/METHOD      llabel       Llabel             /],
        -orient       => [$sl,        qw/orient       Orient   horizontal/],
        -rlabel       => [qw/METHOD      rlabel       Rlabel             /],  
        -showvalue    => [$sl,        qw/showValue    ShowValue         0/],
        -sliderlength => [$sl,        qw/sliderLength SliderLength     15/],
        -sliderrelief => [$sl,        qw/sliderRelief SliderRelief raised/],
        -to           => [$sl,        qw/to           To                1/],
        -troughcolor  => [$sl,        qw/troughColor  TroughColor        /],
        -width        => [$sl,        qw/width        Width             8/],
        -variable     => [$sl,        qw/variable     Variable           /],
        'DEFAULT'     => [$ll, $rl],
    );

    $self->{ll} = $ll;
    $self->{sl} = $sl;
    $self->{rl} = $rl;

    $self->bind('<Configure>' => sub {
	my ($self) = @_;
	my $orient = $self->cget(-orient);
	return if $orient eq 'horizontal';
	my ($ll, $sl, $rl) = ($self->{ll}, $self->{sl}, $self->{rl});
	$ll->packForget;
	$sl->packForget;
	$rl->packForget;
	$ll->pack;
	$sl->pack;
	$rl->pack;
    });

} # end Populate

# Private methods and subroutines.

sub llabel {
    my ($self, $args) = @_;
    $self->{ll}->configure(@$args);
} # end llabel

sub rlabel {
    my ($self, $args) = @_;
    $self->{rl}->configure(@$args);
} # end rlabel

1;
__END__