##############################################################################
# Tk::resizeButton
# 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: 11/17/1998
# Revision: $Revision$
##############################################################################
#
# Updated by Slaven Rezic
#
# XXX needs lot of work:
# * position columnbar correctly and only use MoveColumnBar to move it instead
# of destroying it and re-creating with CreateColumnBar
# * use Subwidget('scrolled') if it exists
# * don't give error if -command is not specified
# * don't let the user hide columns (minwidth?)
package Tk::resizeButton;
use base qw(Tk::Derived Tk::Button);
Construct Tk::Widget 'resizeButton';
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');
return $class;
}
sub Populate
{
my ($this,$args) = @_;
# CREATE THE RESIZE CONTROLS
my $l_Widget;
for (my $i = 0; $i < 2; ++$i)
{
$l_Widget = $this->Component
(
'Frame' => 'Trim_'.$i,
'-background' => 'white',
'-relief' => 'raised',
'-borderwidth' => 2,
'-width' => 2,
);
$l_Widget->place
(
'-x' => - ($i * 3 + 2),
'-relheight' => 1.0,
'-anchor' => 'ne',
'-height' => - 4,
'-relx' => 1.0,
'-y' => 2,
);
}
$l_Widget->bind ('<ButtonRelease-1>' => sub {$this->ButtonRelease (1);});
$l_Widget->bind ('<ButtonPress-1>' => sub {$this->ButtonPress (1);});
$l_Widget->bind ('<Motion>' => sub {$this->ButtonOver (1);});
$this->SUPER::Populate($args);
$this->ConfigSpecs(
'-widget' => [['SELF', 'PASSIVE'], 'Widget', 'Widget', undef],
'-column' => [['SELF', 'PASSIVE'], 'Column', 'Column', 0]
);
# Keep track of last trim widget
$this->{'m_LastTrim'} = $l_Widget;
}
sub ButtonPress{
my ($this, $p_Trim) = (shift, @_);
$this->{'m_relief'} = $this->cget('-relief');
if ($this->ButtonEdgeSelected() || $p_Trim)
{
$this->{'m_EdgeSelected'} = 1;
$this->{m_X} = $this->pointerx() - $this->rootx();
CreateColumnBar($this);
}
else
{
$this->configure ('-relief' => 'sunken');
$this->{m_X} = -1;
}
}
sub ButtonRelease {
my ($this, $p_Trim) = (shift, @_);
$this->{'m_EdgeSelected'} = 0;
$this->configure ('-relief' => $this->{'m_relief'});
if ($this->{columnBar}){
$this->{columnBar}->destroy;
undef $this->{columnBar};
}
if ($this->{m_X} >= 0)
{
my $l_NewWidth =
(
$this->pointerx() -
$this->rootx()
);
my $hlist = $this->cget('-widget');
my $col = $this->cget('-column');
$$hlist->columnWidth($col, $l_NewWidth+5);
$this->GeometryRequest
(
$l_NewWidth,
$this->reqheight(),
);
}
elsif (! $this->ButtonEdgeSelected ())
{
$this->Callback('-command');
}
$this->{m_X} = -1;
}
# CHECK IF THE RESIZE CONTROL IS SELECTED
sub ButtonEdgeSelected{
my ($this) = @_;
{
return ($this->pointerx() - $this->{m_LastTrim}->rootx()) > -1;
}
}
# CHANGE THE CURSOR OVER THE RESIZE CONTROL
sub ButtonOver{
my($this, $p_Trim) = @_;
my ($cursor);
if ($this->{'m_EdgeSelected'} || $this->ButtonEdgeSelected() || $p_Trim){
if ($this->{columnBar}){
$this->{columnBar}->destroy;
CreateColumnBar($this);
}
$cursor = 'sb_h_double_arrow' ;
}
else{
$cursor = 'left_ptr';
}
$this->configure(-cursor => $cursor);
}
# Create a column bar which displays on top of the HList widget
# to indicate the eventual size of the column.
sub CreateColumnBar{
my($this) = @_;
my $hlist = $this->cget('-widget');
my $height = $$hlist->height() - $this->height();
my $x = $$hlist->pointerx() - $$hlist->rootx();
# my $x = $this->rootx + $this->width - $$hlist->rootx;
$this->{columnBar} = $$hlist->Frame(
'-background' => 'white',
'-relief' => 'raised',
'-borderwidth' => 2,
'-width' => 2,
);
#FIXFIX: Some fudge factors were used here to place the column
# bar at the correct place. It appears that hlist->rootx is
# relative to the scrollbar, while when placing the columnbar
# the x location is relative to hlist widget. This definitely
# doesn't work when using a non-scrolled hlist.
$this->{columnBar}->place
(
'-x' => $x,
'-height' => $height-5,
'-relx' => 0.0,
'-rely' => 0.0,
'-y' => $this->height()+5,
);
}
1;
syntax highlighted by Code2HTML, v. 0.9.1