lib/Tk/HdrResizeButton.pm

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(); } );

	$this->SUPER::Populate($args);
	$this->ConfigSpecs(
		-column 			=> [ [ 'SELF', 'PASSIVE' ], 'column', 'Column', 0 ],
		-minwidth			=> [ [ 'SELF', 'PASSIVE' ], 'minwidth', 'MinWidth', 50 ], 
		-closedminwidth		=> [ [ 'SELF', 'PASSIVE' ], 'closedminwidth', 'ClosedMinWidth', 10 ], 
    	-command 			=> [ 'CALLBACK',undef,undef, sub {}],
		-activebackground	=> [ [ 'SELF', 'PASSIVE' ], 'activebackground', 'activebackground', $this->SUPER::cget(-background) ],
		-activeforeground	=> [ [ 'SELF', 'PASSIVE' ], 'activeforeground', 'activeforeground', 'red' ],
		-buttondownrelief	=> [ [ 'SELF', 'PASSIVE' ], 'buttondownrelief', 'buttondownrelief', 'groove' ],
		-relief 			=> [ [ 'SELF', 'PASSIVE' ], 'relief', 'relief', 'flat' ],
		-pady				=> [ [ 'SELF', 'PASSIVE' ], 'pady', 'pady', 0 ],
		-padx				=> [ [ 'SELF', 'PASSIVE' ], 'padx', 'padx', 0 ],
		-pady				=> [ [ 'SELF', 'PASSIVE' ], 'pady', 'pady', 0 ],
		-anchor				=> [ [ 'SELF', 'PASSIVE' ], 'anchor', 'Anchor', 'w' ],
		-lastcolumn			=> [ [ 'SELF', 'PASSIVE' ], 'lastcolumn', 'LastColumn', 0 ],
		-takefocus			=> [ [ 'SELF', 'PASSIVE' ], 'takefocus', 'TakeFocus', 1 ],
	);

	# Keep track of last trim widget
	$this->{m_LastTrim} = $r_Widget;
	# Initialize the Enter/Leave level counter
	$this->{m_Level} = 0;
}
# CALLED IF WE ENTER THE TRIM AREA
sub BttnEnter
{
	my $this = shift;
	$this->StateSalvation(1);
	$this->configure(-relief => $this->cget('-buttondownrelief')) if $this->{m_ButtonPress};
}
# CALLED IF WE LEAVE THE TRIM AREA
sub BttnLeave
{
	my $this = shift;
	$this->StateSalvation(-1);
	$this->configure(-relief => $this->{m_relief}) if $this->{m_relief};
}
# CALLED IF WE ENTER THE TRIM AREA
# sub TrimEnter
# {
# 	my $this = shift;
# 	$this->ButtonOver(1);
# 	$this->StateSalvation(2);
# }
sub TrimEnter
{
	my $this = shift;
	if ($this->cget('-lastcolumn')) {
		$this->Subwidget('Trim_R')->configure(-cursor => undef);
	}
	else {
		$this->Subwidget('Trim_R')->configure(-cursor => 'sb_h_double_arrow');
	}
	$this->ButtonOver(1);
	$this->StateSalvation(2);
}
# CALLED IF WE LEAVE THE TRIM AREA
sub TrimLeave
{
	my $this = shift;
	$this->StateSalvation(-2);
	$this->HideColumnBar();
}

# CALLED IF WE CLICK/DOUBLECLICK
sub OpenCloseColumn
{
	my $this = shift;

	my $column = $this->cget('-column');
	if ($this->{m_ColumClosed}{$column}) {
		$this->{m_ColumClosed}{$column} = 0;
		if ($this->{m_LastColumWidth}) {
			$this->parent->columnWidth($column, $this->{m_LastColumWidth});
		}
		else {
			$this->parent->columnWidth($column, '');
			$this->{m_LastColumWidth} = $this->parent->columnWidth($column);
		}
		$this->configure(-anchor => $this->{m_LastAnchor}) if $this->{m_LastAnchor};
	}
	else {
		$this->{m_ColumClosed}{$column} = 1;
		$this->{m_LastColumWidth} = $this->parent->columnWidth($column);
		$this->parent->columnWidth($column,  $this->cget('-closedminwidth'));
		$this->{m_LastAnchor} = $this->cget('-anchor');
		$this->configure(-anchor => 'w');
	}
	
}
# CALLED TO RESIZE A COLUMN TO THE NEEDED EXTENT
sub ColumnFullSize
{
	my $this = shift;
	my $column = $this->cget('-column');
	if ($this->{m_ColumClosed}{$column}) {
		delete $this->{m_LastColumWidth}; # This ensure immediate update
		$this->OpenCloseColumn();
	}
	else {
		$this->parent->columnWidth($column, '');
	}
}

## Event Handlers
sub ButtonPress
{
	my ($this, $p_Trim) = @_;
	$this->{m_LastEvent} = 'ButtonPress';	
	$this->{m_relief} = $this->cget('-relief');
	if ($this->ButtonEdgeSelected() || $p_Trim) {
		$this->{m_EdgeSelected} = 1;
		$this->{m_X} = $this->pointerx() - $this->rootx();
		$this->ButtonOver();
	}
	else {
		$this->configure(-relief => $this->cget('-buttondownrelief'));
		$this->{m_X} = -1;
	}
	$this->{m_ButtonPress} = 1;
}

sub ButtonRelease
{
	my ($this, $p_Trim) = @_;
	delete $this->{m_ButtonPress};
	$this->{m_EdgeSelected} = 0;
	$this->configure(-relief => $this->{m_relief});
	if ($this->{columnBar}) {
		$this->HideColumnBar();
	}
	if ($this->{m_X} >= 0) {
		my $l_NewWidth = ( $this->pointerx() - $this->rootx() );

		my $hlist = $this->parent;
		my $col   = $this->cget('-column');
		# Better resize to minimum than to do nothing
		$l_NewWidth = $this->cget('-minwidth') if ($l_NewWidth + 5) < $this->cget('-minwidth');
		$hlist->columnWidth( $col, $l_NewWidth + 5 );

		$this->GeometryRequest( $l_NewWidth, $this->reqheight() );
	} 
	elsif ( !$this->ButtonEdgeSelected() ) {
		# Run only if we're still over the header and if we're in TRUE Release Mode (No Dbl-Click)
		if ($this->cget('-state') eq 'active') {
			$this->after(500, sub { $this->Callback(-command => $this) if $this->{m_LastEvent} eq 'ButtonPress' } );
		}
	}

	$this->{m_X} = -1;
}

# CALLED IF WE DOUBLECLICK
sub ButtonDouble1
{
	my $this = shift;
	
	# Cancel a scheduled Release-Bttn-1 - attached Event
	$this->{m_LastEvent} = 'DoubleClick';

	# Execute the double-click default action
	$this->OpenCloseColumn();
}


# CHECK IF THE RESIZE CONTROL IS SELECTED
sub ButtonEdgeSelected
{
	my $this = shift;
	return ( $this->pointerx() - $this->{m_LastTrim}->rootx() ) > -1;
}

# CHANGE THE CURSOR OVER THE RESIZE CONTROL
sub ButtonOver
{
	my ($this, $p_Trim) = @_;
	if ( $this->{'m_EdgeSelected'} || $this->ButtonEdgeSelected() || $p_Trim ) {
		$this->MoveColumnBar() if $this->{columnBar};
	}
}
# AVOID ACTIVATING THE BUTTON, IF WE ARE IN THE TRIM
sub StateSalvation
{
	my ($this, $newlevel) = @_;
	if ($newlevel > 0) {
		$this->{m_Level}  |= $newlevel;
	}
	else {
		$this->{m_Level}  &= ~$newlevel;
	}
	if ($this->{m_Level} == 1 and not $this->{m_EdgeSelected}) {
		$this->configure(-state => 'active');
	}
	else {
		$this->configure(-state => 'normal');
	}
}

# Move a column bar which displays on top of the HList widget
# to indicate the eventual size of the column.
sub MoveColumnBar
{
	my $this = shift;

	my $hlist = $this->parent;
	my $height = $hlist->height() - $this->height();
	my $x      = $hlist->pointerx() - $hlist->rootx() + 1; # +1 for move right into gap

	$this->{columnBar}->place(
		'-x'      => $x,
		'-height' => $height - 5,
		'-y'      => $this->height() + 5,
	) unless $this->cget('-lastcolumn');
}
# REMOVES IT FROM DISPLAY without destroying it
sub HideColumnBar
{
	my $this = shift;
	$this->{columnBar}->placeForget();
}

########################################################################
1;
__END__


=head1 NAME

Tk::HdrResizeButton - provides a resizeable button for a HList column header.

=head1 SYNOPSIS

    use Tk;
    use Tk::HList;
    use Tk::HdrResizeButton;

    my $mw = MainWindow->new();

    # CREATE MY HLIST
    my $hlist = $mw->Scrolled('HList',
         -columns=>2, 
         -header => 1
         )->pack(-side => 'left', -expand => 'yes', -fill => 'both');

    # CREATE COLUMN HEADER 0
    my $headerstyle   = $hlist->ItemStyle('window', -padx => 0, -pady => 0);
    my $header0 = $hlist->HdrResizeButton( 
          -text => 'Test Name', 
          -relief => 'flat', -pady => 0, 
          -command => sub { print "Hello, world!\n";}, 
          -column => 0
    );
    $hlist->header('create', 0, 
          -itemtype => 'window',
          -widget => $header0, 
          -style=>$headerstyle
    );

    # CREATE COLUMN HEADER 1
    my $header1 = $hlist->HdrResizeButton( 
          -text => 'Status', 
          -command => sub { print "Hello, world!\n";}, 
          -column => 1
    );
    $hlist->header('create', 1,
          -itemtype => 'window',
          -widget   => $header1, 
          -style    => $headerstyle
    );

=head1 DESCRIPTION

The HdrResizeButton widget provides a resizeable button widget for use
in an HList column header.  When placed in the column header, the right
edge of the widget can be selected and dragged to a new location to
change the size of the HList column.  When resizing the column, a 
column bar will also be placed over the HList indicating the eventual
size of the HList column.  A command can also be bound to the button
to do things like sorting the column.
On DoubleClicking a Column it is closed / re-opened. A Right-ButtonClick
will resize the column to the fit the needs of all the column contents. 

The widget takes all the options that a standard Button does.
Note: For a proper operationthe following option MUST be specified during creation:

=over 4

=item B<-column>

The column number that this HdrResizeButton is associated with.
(It has to be provided to resize the appropriate column).

=back

In addition, the following options may be specified:

=over 4

=item B<-command>

The default command is associated with an open/close function for the selected
column. The function is called with a Tk::HdrResizeButton reference for custom usage.

=item B<-activebackground>

The background color used for the column Header during active state (Mouse over Header).

=item B<-activeforeground>

The foreground color used for the column Header during active state (Mouse over Header).

=item B<-buttondownrelief>

The relief used for the column Header Button during selected state (Button pressed).

=item B<-minwidth>

The minwidth is used for the specific column (during resize), default: 30.

=item B<-closedminwidth>

The closedminwidth is used for the specific column (while in "CLOSED" view), default: 10.

=item B<-resizerwidth>

The resizerwidth is the resize sensor-area on the right border of the specific column, default: 1.


=back

=head1 AUTHOR

B<Shaun Wandler> <wandler@unixmail.compaq.com>


=head1 UPDATES

Updated by Slaven Rezic and Frank Herrmann,
Enhanced/Modified by Michael Krause KrauseM_AT_gmx_DOT_net

=over 4

=item DONE (MK) position columnbar correctly and only use MoveColumnBar to move it instead
	of destroying it and re-creating with CreateColumnBar

=item (???) use Subwidget('scrolled') if it exists

=item DONE (MK) don't give error if -command is not specified

=item DONE (MK) don't let the user hide columns (minwidth?)

=item DONE (MK) * double-click on column should not more execute the single-click command callback

=back

=head1 KEYWORDS

Tk::HList

=cut

###
### EOF
###
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)