PerlTk - Getting a scrolled widget's scrollbar from within an object

Author

Getting a scrolled widget's scrollbar from within an object

zentara

2006-04-09, 7:02 pm

Hi,

I've worked out a way to maintain the position of a background image on
a canvas, as the canvas is scrolled.

I would like to make this automatic from with a derived Canvas widget,
which has been set up as a scrolled widget in the main script.

So in the example below, I can print out the ybar widget from the
main script, but I have not been able to find a way, to get the
ybar from within the package code.

I've tried all sorts of SUPER stuff, and have no clue which one
I should show, so I leave it out, and hope one of you can show me
how to get the yscrollbar from within the package.

Thanks.

#!/usr/bin/perl

package CanvasDirTree;
use warnings;
use strict;
use Data::Dumper;

use Tk::widgets qw/Canvas/;
use base qw/Tk::Derived Tk::Canvas/;

Construct Tk::Widget 'CanvasDirTree';

sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
return $class;
}

sub bind{
my $self = shift;
$self->CanvasBind(@_);
}

######################################3
sub SetBindtags {
my($self) = @_;
$self->SUPER::SetBindtags;
}

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

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

print Dumper(\$self),"\n";

} # end Populate

########################################
###############################
package main;
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new();

my $frame = $mw->Frame()->pack(-expand=>1,-fill=>'both');

my $ztree = $frame->Scrolled('CanvasDirTree',
-bg =>'white',
-width =>300,
-height =>300,
-scrollbars =>'osw',
-scrollregion => [0,0,600,600],
)->pack(-side=>'left',-fill=>'both', -expand=>1);

my $button = $mw->Button(-text=>'Exit',-command=>sub{exit})->pack();

# how do I get the ybar from the package code?
my $ybar = $ztree->Subwidget('yscrollbar');
print "ybar $ybar\n";

MainLoop;

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Ch Lamprecht

2006-04-09, 7:02 pm

zentara schrieb:
> Hi,
>
> I've worked out a way to maintain the position of a background image on
> a canvas, as the canvas is scrolled.
>
> I would like to make this automatic from with a derived Canvas widget,
> which has been set up as a scrolled widget in the main script.
>
> So in the example below, I can print out the ybar widget from the
> main script, but I have not been able to find a way, to get the
> ybar from within the package code.
>
> I've tried all sorts of SUPER stuff, and have no clue which one
> I should show, so I leave it out, and hope one of you can show me
> how to get the yscrollbar from within the package.
>
> Thanks.
>
> #!/usr/bin/perl
>
> package CanvasDirTree;
> use warnings;
> use strict;
> use Data::Dumper;
>
> use Tk::widgets qw/Canvas/;
> use base qw/Tk::Derived Tk::Canvas/;
>
> Construct Tk::Widget 'CanvasDirTree';
>
<snip>

sub _get_bars {
my $self = shift;
my $x = $self->parent->Subwidget('xscrollbar');
my $y = $self->parent->Subwidget('yscrollbar');
return ($x,$y);
}

HTH Christoph

--

perl -e "print scalar reverse q/ed.enilno@ergn.l.hc/"

zentara

2006-04-10, 8:12 am

On Mon, 10 Apr 2006 00:46:28 +0200, Ch Lamprecht
<christoph.lamprecht.no.spam@web.de> wrote:

>sub _get_bars {
> my $self = shift;
> my $x = $self->parent->Subwidget('xscrollbar');
> my $y = $self->parent->Subwidget('yscrollbar');
> return ($x,$y);
>}

Hi, that seems to work, but only after the $mw is visible.
Is it possible to run that from populate?

I hate to keep bothering you, but I find this module
bindings stuff, really pretzel-logic.

Maybe I'm going about this the wrong way. What I really
need to do is have the object emit a signal tied to the
yscrollbar. So when the yscrollbar is moved, I can do some
internal calculations. My idea was to get the yscrollbar,
as you have shown, then redefine it's yscrollcommand
to do my calculations. Maybe I just need a way to bind
to <<Scroll>>?

For the idea I'm trying to incorporate into the module,
see http://perlmonks.org?node_id=541975
In that node, I manually change the yscrollcommand
of the yscrollbar, but in the module, if I could just somehow
bind to the scroll, I could use that callback to do what I need.
Any ideas? Do I really need the yscrollbar?

For instance, the following only gives the $x $y values
when called from main. How would I be able to get the
$yscrollbar and alter it's yscrollcommand from populate?
The following dosn't work until the _get_bars is called from
main.

In summary:
What is the best way to bind to the yscroll from inside the object?

#!/usr/bin/perl
package CanvasDirTree;
use warnings;
use strict;
use Data::Dumper;

use Tk::widgets qw/Canvas/;
use base qw/Tk::Derived Tk::Canvas/;

Construct Tk::Widget 'CanvasDirTree';

sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
return $class;
}

sub bind{
my $self = shift;
$self->CanvasBind(@_);
}

######################################3
sub SetBindtags {
my($self) = @_;
$self->SUPER::SetBindtags;
}

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

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

print "populating\n";
my ($x,$y) = $self->_get_bars();
print "$x $y\n"; # undefined here, until visibility?

} # end Populate

########################################
###############################
sub _get_bars {
my $self = shift;
print "in _get_bars\n";
my $x = $self->parent->Subwidget('xscrollbar');
my $y = $self->parent->Subwidget('yscrollbar');
return ($x,$y);
}
########################################
##############################

package main;
use warnings;
use strict;
use Tk;
use Data::Dumper;

my $mw = MainWindow->new();

$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=>int(-18*18/14));

my $frame = $mw->Frame()->pack(-expand=>1,-fill=>'both');

my $ztree = $frame->Scrolled('CanvasDirTree',
-bg =>'white',
-width =>300,
-height =>300,
-scrollbars =>'osw',
-scrollregion => [0,0,600,600],
)->pack(-side=>'left',-fill=>'both', -expand=>1);

my $button = $mw->Button(-text=>'Exit',-command=>sub{exit})->pack();

#comment out this line, and _get_bars dosn't work from populate
print "main->", $ztree->_get_bars(),"\n";

MainLoop;
__END__

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Ch Lamprecht

2006-04-10, 8:12 am

zentara schrieb:
> On Mon, 10 Apr 2006 00:46:28 +0200, Ch Lamprecht
> <christoph.lamprecht.no.spam@web.de> wrote:
>
>
>
>
>
> Hi, that seems to work, but only after the $mw is visible.
> Is it possible to run that from populate?

No, that's because Tk::Widget->Scrolled('widget') creates the 'widget'
before the Scrollbars...
Maybe you can set a hook using 'Map' or 'Visibility' events ?
Or (dirty trick) :

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

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

print "populating\n";
$self->after(2000,sub{my ($x,$y)=$self->_get_bars();
print "$x $y\n";
});
} # end Populate

HTH, Christoph

--

perl -e "print scalar reverse q/ed.enilno@ergn.l.hc/"

zentara

2006-04-10, 7:00 pm

On Mon, 10 Apr 2006 16:07:26 +0200, Ch Lamprecht
<christoph.lamprecht.no.spam@web.de> wrote:

>zentara schrieb:
>
>No, that's because Tk::Widget->Scrolled('widget') creates the 'widget'
>before the Scrollbars...
>Maybe you can set a hook using 'Map' or 'Visibility' events ?
>Or (dirty trick) :

Hey, the "dirty trick" works with a delay value of 1. So that's
acceptable, I guess it just needs any delay to let the widget
setup first. :-)

>
>sub Populate {
> my ($self, $args) = @_;
>
> $self->SUPER::Populate($args);
> $self->SetBindtags;
>
> print "populating\n";
> $self->after(2000,sub{my ($x,$y)=$self->_get_bars();
> print "$x $y\n";
> });
>} # end Populate
>

$self->after(1, sub{my ($x,$y)=$self->_get_bars();
print "$x $y\n";
});

>HTH, Christoph

It certained did, thanks.

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Sponsored Links