First I created a callback for the scrolling action.

This call back then gets the current canvas position (via the sub xview and yview), moves the canvas (again via xview and yview), and finally gets the new position of the canvas

The return value of xview and yview is a percentage of the canvas that is not seen compared to the total scrollable area. So, it is just simple arithmetic to see how far the canvas actually scrolled.

Finally, I just moved the rectangle the same amount the canvas moved.

Modified Code:

#!/usr/bin/perl -w

use Tk;
use strict;

# Main program / GUI setup
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas', -width => 200, -height => 200)->grid;
$c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 
+]);

#Grid
$c->createGrid(0, 0, 10, 10);
$c->createGrid(0, 0, 100, 100, -lines => 1, -dash => '.-');

$c->pack(-expand => 1, -fill => 'both');

my $rect = $c->createRectangle(20, 20, 40, 40, 
    -outline => 'yellow', 
    -fill => 'yellow');
    
# get scrollbars
my $xscroll = $c->Subwidget("xscrollbar");
my $yscroll = $c->Subwidget("yscrollbar");

# create callbacks for scrollbars
$xscroll->configure(-command=>[\&scrolled,'x']);
$yscroll->configure(-command=>[\&scrolled,'y']);

MainLoop;

sub scrolled {
    my $dir = shift;  # what direction


    my (@xbefore,@ybefore);
    my (@xafter,@yafter);
    
    # debug statement
    print "${dir}scrolled: <",join("><",@_),">\n";

    # get data before moving 
    @xbefore = $c->xview();
    @ybefore = $c->yview();

    # move canvas
    if ($dir eq 'x') {$c->xview(@_)};
    if ($dir eq 'y') {$c->yview(@_)};

    # get data after moving
    @xafter=$c->xview();
    @yafter=$c->yview();
    
    # what is the scrollregion
    my @scrolls = $c->cget(-scrollregion);
    print "scrolled @scrolls\n";
    
    # movement in x direction is
    my $xmv = ($xafter[0] - $xbefore[0])*($scrolls[2]-$scrolls[0]);
    
    # movement in y direction is
    my $ymv = ($yafter[1] - $ybefore[1])*($scrolls[3]-$scrolls[1]);
    
    # move the rectangle to compensate for canvas move
    print "moving $xmv $ymv\n";
    $c->move($rect,$xmv,$ymv);
}
[download]

Sandy

PS: Thanks, that was fun!

UPDATE: If window is expanded and contracted such that the yellow box is no longer visible, then no amount of scrolling will make it visible again. Mmmm.