Stationary background on Scrolled Tk-Canvas
zentara
created: 2006-04-07 17:01:12
I was toying around with how to make a stationary background "appear" to stay in place, as a Tk::Canvas was scrolled. It is more of an optical illusion, but it works. In the script below, the background image appears to stay stationary with scrolling. A very fine point being the ratio used in a scrolled widget. See the $div variable. It is not obvious, because you must account for the REAL canvas size, (which includes the default border).

Anyways, this will take a photo as ARGV[0] on the commandline, or will retreive an image from the net (if no image is given).

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;

my $mw=tkinit;

my $imagin = shift;
$imagin ||= '';
my $image;

if(length $imagin){
   $image  = $mw->Photo(-file =>$imagin);
}else{
   $image = &get_photo;
}

my $ph = 400;
my $c = $mw->Scrolled('Canvas',
     -width=>400,
     -height=>$ph,
     -bg=>'white',
     -scrollregion=>[0,0,1000,1000],
     -scrollbars=>'sw')->pack(-expand=>1, -fill=>'both');


my $bimage = $c->createImage( 0,0,
         -anchor => 'nw',
         -image  => $image,
    );

for(0..500){
 if( $_ % 2 == 0){
      $c->createRectangle(0,  5 + $_ * 10, 30,  15 + $_ *10,
              -fill =>'hotpink',
            );
      
      $c->createText( 3, 5 + $_ * 10,
              -fill =>'white',
              -text => $_,
	      -anchor =>'nw',
	    );
  
      next;
     }
 }

my $ybar = $c->Subwidget("yscrollbar");
$ybar->configure(
           -background => "lightgreen", 
           -activebackground => "green",
	   -troughcolor => "black",
           -command => \&yscrollcallback,
        );

my $real_can = $c->Subwidget('scrolled');

$mw->Button(-text =>'Change Scroll Region',
            -command =>sub{
	    $c->configure(-scrollregion =>[0,0,2000,2000]);
	    })->pack();

MainLoop;
######################################################################
#if you specify a yscrollcallback, you will override the
#normal scroll behavior.

sub yscrollcallback{
    #restore original function
    $c->yview(@_);
 
   my($z,$z1) = $c->yview;

   my(undef,undef,undef,$sry) = $c->cget('scrollregion');

   my $real_can_h = $real_can->reqheight; 
   print "$sry  $real_can_h\n";
   my $div = $sry/$real_can_h;  
   print "div $div\n";

$c->coords($bimage, 0,  $div *$z * $real_can_h  );
$c->update;
   
}

##########################################################################3
sub get_photo{

 use LWP::Simple;
 use MIME::Base64;

 my $URL = 'http://zentara.net/2uni2.jpg';
 
 my $content = encode_base64(get($URL));
  
return $mw->Photo(-data => $content);

}


Re: Stationary background on Scrolled Tk-Canvas
created: 2006-05-16 08:32:04

Looks very nice, but what I am missing is the horizontal scroll and using the Mouse wheel to scroll.
But I assume that that is left for the reader as an exercise! ;-)

Go Fish!

Re^2: Stationary background on Scrolled Tk-Canvas
created: 2006-05-16 08:54:29
Yeah, left as an exercise for the reader. ( but if you figure it out, don't forget to post it). :-) If you want to try the module, it's at Tk-Canvas-DirTree

I'm not really a human, but I play one on earth. flash japh

perlmonks.org content © perlmonks.org and aukjan, zentara

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03