tamaguchi has asked for the wisdom of the Perl Monks concerning the following question:


Problem1.
I have a yellow rectangle on scrolled canvas...
#!/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');

MainLoop;

[download]
..which is the best way to make the rectangle float in the same place regardless of in which direction the canvas in scrolled?


Problem2.
Here are two rectangles red and green on a scrolled canvas... 
#!/usr/bin/perl -w             
use Tk;
use strict;  
                                                
my $mw = MainWindow->new;

$mw->geometry('300x300'); #try this
 
my $c = $mw->Scrolled('Canvas',
-width => 200,
-height => 200,
-background =>'blue',
-scrollregion => [ 0, 0, 500, 500 ]
)->pack(-expand => -2, -fill => 'both');

$c->createRectangle(100, 100, 150, 150, -fill => 'red');
$c->createRectangle(100, 400, 150, 450, -fill => 'green');

my $plus = $c->Button( 
   -text    => '  +  ', 
       -command => sub {$c->scale("all", 125, 125, 2, 2); } );
   $plus->pack;      
   
my $minus = $c->Button( 
    -text    => '  .  ', 
    -command => sub {$c->scale("all", 125, 125, 0.5, 0.5); } );
   $minus->pack;  


MainLoop;

[download]
...when the canvas is zoomed by 2x by clicking the '+' button the canvas remains in the same size which means that the areas not fitting in the new zoom disapear outside the visible area. (For example it is not possible to scroll to the green rectangle when zooming once.)How is it possible to zoom in a way so that the areas over which it is possible to scroll are expanded to contain the areas that do not fit to the new larger zoom. Thank you very much for your advice.

Replies are listed 'Best First'.
Re: Two questions regarding -tk-canvas
by Sandy (Curate) on Oct 18, 2006 at 19:49 UTC
    This is my solution for problem number 1.

    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]
    Cheers

    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.

[reply]
[d/l]
      Thank very much you Sandy. Your skills are excellent.
[reply]
Re: Two questions regarding -tk-canvas
by Khen1950fx (Canon) on Oct 19, 2006 at 01:32 UTC
    First, my hat's off to Sandy. She did a great job. Second, a solution for the 2nd problem: I think you need to use the -confine option.  -confine => 1 won't allow the display to go outside the scroll region; instead, using -confine => 0 will. Then

    my $c = $mw->Scrolled('Canvas',
    -confine => 0
    -width => 200,
    -height => 200,
    -background =>'blue'
    -scroll => [ 0, 0, 500, 500 ]
)->pack(-expand => -2, -fill => 'both');

MainLoop;

    [download]
[reply]
[d/l]
[select]
Re: Two questions regarding -tk-canvas
by rcseege (Pilgrim) on Oct 19, 2006 at 06:35 UTC

    As for question 2, all you should have to do is increase or decrease the scrollregion for the Canvas, as you scale the objects inside it. It should be a simple matter of calling cget on the -scrollregion option, and then reconfiguring it on once you've recalculated it's values. You may have to play with it a bit, but it should work.

    Rob
[reply]

Back to Seekers of Perl Wisdom