view release on metacpan or  search on metacpan

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

package Tk::HdrResizeButton;
#------------------------------------------------
# automagically updated versioning variables -- CVS modifies these!
#------------------------------------------------
our $Revision    = '$Revision: 1.4 $';
our $CheckinDate = '$Date: 2009/04/06 20:46:00 $';
our $CheckinUser = '$Author: xpix $';

# we need to clean these up right here
$Revision    =~ s/^\$\S+:\s*(.*?)\s*\$$/$1/sx;
$CheckinDate =~ s/^\$\S+:\s*(.*?)\s*\$$/$1/sx;
$CheckinUser =~ s/^\$\S+:\s*(.*?)\s*\$$/$1/sx;

#-------------------------------------------------
#-- package Tk::HdrResizeButton ---------------------
#-------------------------------------------------
use vars qw ($VERSION);
$VERSION = '1.5';

#########################################################################
# Tk::HdrResizeButton 
# Summary:  This widget creates a button for use in an HList header which
#           provides methods for resizing a column. This was heavily 
#	    leveraged from Columns.pm by Damion Wilson.
# Author:   Shaun Wandler
# Date:     $Date: 2009/04/06 20:46:00 $
# Revision: $Revision: 1.5 $
#########################################################################=
#####
#
# Updated by Slaven Rezic and Frank Herrmann, Michael Krause
#

# XXX needs lot of work:
# DONE (MK) * position columnbar correctly and only use MoveColumnBar to move it instead
# 	of destroying it and re-creating with CreateColumnBar
# (for what?) * use Subwidget('scrolled') if it exists
# DONE (MK) * don't give error if -command is not specified
# DONE (MK) * don't let the user hide columns (minwidth?)
# DONE (MK) * double-click on column should not more execute the single-click command callback
# DONE (MK) * configurable closedcolWidth, ResizeWidth

use base qw(Tk::Derived Tk::Button);
use strict;

Construct Tk::Widget 'HdrResizeButton';

sub ClassInit
{
	my ($class, $mw) = @_;
	$class->SUPER::ClassInit($mw);
	$mw->bind( $class, '<ButtonRelease-1>', 'ButtonRelease' );
	$mw->bind( $class, '<ButtonPress-1>',   'ButtonPress' );
	$mw->bind( $class, '<Motion>',          'ButtonOver' );
	$mw->bind( $class, '<ButtonRelease-3>', 'ColumnFullSize' );
	$mw->bind( $class, '<Double-1>',        'ButtonDouble1' );

	# Override these ones too
	$mw->bind($class, '<Enter>', 'BttnEnter' );
	$mw->bind($class, '<Leave>', 'BttnLeave' );

	return $class;
}

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

	# CREATE THE RESIZE CONTROL
	my $r_Widget;
	my $r_width = delete $args->{-resizerwidth} || 1;
	$r_Widget = $this->Component(
		'Frame'      => 'Trim_R',
		#-background  => 'white',
		#-relief      => 'raised',
		-borderwidth => 1,
		-width       => $r_width,
		-cursor 	 => 'sb_h_double_arrow',
	)->place(
		-bordermode => 'outside',
		-relheight => '1.0',
		-anchor	=> 'ne',
		-relx  	=> '1.0',
	);

	# CREATE THE COLUMNBAR
	$this->{columnBar} = $this->parent->Frame(
		-background  => 'white',
		-relief      => 'raised',
		-borderwidth => 2,
		-width       => 2,
	);

	$r_Widget->bind( '<ButtonRelease-1>'	=> sub { $this->ButtonRelease(1); } );
	$r_Widget->bind( '<ButtonPress-1>'		=> sub { $this->ButtonPress(1); } );
	$r_Widget->bind( '<Motion>' 			=> sub { $this->ButtonOver(1); } );
	$r_Widget->bind( '<Enter>'				=> sub { $this->TrimEnter(); } ); 
	$r_Widget->bind( '<Leave>'				=> sub { $this->TrimLeave(); } );

	# Override these ones too
	$this->bind( '<Enter>'					=> sub { $this->BttnEnter(); } );
	$this->bind( '<Leave>'					=> sub { $this->BttnLeave(); } );