view release on metacpan or  search on metacpan

Tk/SplitFrame.pm  view on Meta::CPAN

######################################################################
# Modified on January  4, 1998 to correct order of insertion problem #
# Modified on January  7, 1998 to add slider decoration              #
# Modified on January  9, 1998 to correct color name problem         #
# Modified on January 27, 1998 to correct inaccurate border layout   #
# Modified on January 27, 1998 to use proper notify method overload  #
# Modified on January 27, 1998 added -padafter and -padbefore params #
#                              for controlling size of inner widget  #
# Modified on April 6, 1998    Incorporated into release library     #
######################################################################
#                       THIS IS THE CORRECT ONE                      #
######################################################################

package Tk::SplitFrame;

use Tk;
use Tk::ChildNotification;
use Tk::Derived;
use Tk::Widget;
use Tk::Frame;

use base qw (Tk::Derived Tk::Widget Tk::Frame);
use vars qw ($VERSION);
use strict;
use Carp;

$VERSION = '0.02';

Tk::Widget->Construct ('SplitFrame');

sub Populate
   {
    my ($this) = (shift, @_);

    $this->SUPER::Populate (@_);

    my $l_LastBorder = $this->Component
       (
        'Frame' => 'LastBorder',
        '-relief' => 'sunken',
       );

    my $l_FirstBorder = $this->Component
       (
        'Frame' => 'FirstBorder',
        '-relief' => 'sunken',
       );

    my $l_Slider = $this->Component
       (
        'Frame' => 'Slider',
        '-relief' => 'sunken',
        '-borderwidth' => 0,
        '-relief' => 'flat',
       );

    $l_Slider->bind ('<ButtonRelease-1>' => sub {$this->SliderReleased();});
    $l_Slider->bind ('<ButtonPress-1>' => sub {$this->SliderClicked();});
    $l_Slider->bind ('<B1-Motion>' => sub {$this->SliderMoved();});
    $this->bind ('<Configure>' => sub {$this->Redraw();});
    $this->bind ('<Map>' => sub {$this->Redraw();});

    $this->Advertise (FirstBorder => $l_FirstBorder);
    $this->Advertise (LastBorder => $l_LastBorder);
    $this->Advertise (Slider => $l_Slider);

    my $l_BaseColor = $this->cget ('-background');

    $this->ConfigSpecs
       (
        '-orientation' => [['SELF', 'PASSIVE'], 'orientation', 'Orientation', 'vertical'],
        '-trimcolor'   => [['SELF', 'PASSIVE'], 'trimcolor','trimcolor', $l_BaseColor],
        '-background'  => ['SELF','background', 'Background', $l_BaseColor],
        '-borderwidth' => ['METHOD', 'borderwidth', 'BorderWidth', 2],
        '-sliderposition' => ['METHOD', 'sliderposition', 'SliderPosition', 60],
        '-sliderwidth' => [['SELF', 'PASSIVE'], 'SliderWidth', 'SliderWidth', 7],
        '-relief'      => [['SELF', 'PASSIVE'], 'relief', 'Relief', 'flat'],
        '-height'      => [['SELF', 'PASSIVE'], 'height', 'Height', 100],
        '-width'       => [['SELF', 'PASSIVE'], 'width', 'Width', 100],
        '-opaque'      => [['SELF', 'PASSIVE'], 'opaque', 'Opaque', 1],
        '-trimcount'   => [['SELF', 'PASSIVE'], 'trimCount', 'TrimCount', 5],
        '-padbefore'   => [['SELF', 'PASSIVE'], 'padbefore', 'PadBefore', 0],