TK Geometry question.

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

I'd like to have a Canvas in a pane that 'fits' a window.

The canvas has a preordained size, and should not be drawn any larger than 1000x400. Should it be truncated to fit the window that it should appear with scrollbars. I've come close by responding to the event and changing the size of the inner pane, but attempt to control the scrollbars seem to cause the subroutine to exit, and the image gets mangled.

Can this layout be done without configuring elements on every change? > mwfOuter->configure( -scrollbars => $scrollbars); Here is the code:

#!/usr/bin/perl

use Data::Dumper;


# this implements 5 text fields that detect the modified properly


use strict;
use Tk;
use Tk::Pane;
use Tk::Photo;
use Tk::PNG;


my $mw = MainWindow->new;
    $mw->configure(-menu => my $menubar = $mw->Menu);
        my $app =  $menubar->cascade( -label => '~*' ) ; # TODO  -bitm
+ap  =>);
        my $file = $menubar->cascade( -label => '~File');

    my $edit = $menubar->cascade(-label => '~Edit');
    my $go = $menubar->cascade(-label => '~Go');


my $group7;
my @checkboxes ; 

my $messageBar = $mw->Entry( )->pack( -side=>"bottom"  ) ;


$mw->geometry('600x650');

our $lastWidth;
our $lastHeight; 
 

my $frame = $mw->Canvas(  )->form( -top => '20' , -bottom => [ '%100' 
+, -40 ]  , -right => '%95' , -left => '%5' ); # dynamic ! 


my $mwfOuter = $frame->Scrolled('Pane', 
        -scrollbars=>'osoe', 
        -sticky=>'nwse',
        -background=>'white',

        -width => 1000+23, -height => 400+23      # actula dim
)->pack();

my $colourBars  = $mw->Photo ( -file => 'colourBars.png' );
my $stackImage = $mw->Photo ( -file => 'stack.png' ) ; 

my $mwf = $mwfOuter->Pane( 
                 -sticky=>'nwse', -width => 1000 , -height => 400 )->p
+ack()  ; # actual dim 


# this totally works, but you have to set the height  of $mwf to fit t
+he window , which the user can change....

my $label = $mwf->Label( -image => $colourBars  )->place( -x => 0 , -y
+ => 0 );


$mw->bind( '<Configure>' => [ \&gotResized ] ) ;  # we need to change 
+some things... I'd rather live this to Tk

sub gotResized{ 
        my $current_size = $mw->width . "x" . $mw->height;

        if ($lastWidth == $mw->width and $lastHeight == $mw->height ) 
+{ 
                return (0==0);
        };

        # the card area is 10% of the width, and height -60;
        # set the mwfOuter to that size 
        warn $current_size;
        my $scrollbars; 
        my $w = 1100; 
        if ($mw->width < 1100 ) {   # 1.1 * 1000 
                $w = int ($mw->width  * 0.9 )   ;  
                $scrollbars .= 'oe';
        }  
        my $h = 400 ; 
        if ($mw->height < 460 ) { 
                $w = int ($mw->height - 60) ;
                $scrollbars .= 'os';
        };
        warn "scrollbars $scrollbars ";
        #$mwfOuter->configure( -scrollbars => $scrollbars ); #TODO why
+ does this not work?
        if ($w > 50 and $h > 50 ) { 
                warn "Wanting to resize to $w x $h";

                $mwf->configure( -width => $w , -height => $h ) ;  
                $lastWidth = $mw->width ;
                 $lastHeight =$mw->height;
                #warn "Resized" . Dumper (@_) ; 
        };
        return (0==0);
};



MainLoop();
[download]

Comment on TK Geometry question. Download Code

Replies are listed 'Best First'.
Re: TK Geometry question. by Anonymous Monk on Aug 04, 2015 at 00:59 UTC
I'm a little unclear about what you want exactly. It does appear you are missing -scrollregion. Does this small example do what you want? `#!/usr/bin/perl # http://perlmonks.org/?node_id=1137318 use Tk; use strict; use warnings; my $mw = MainWindow->new; my $canvas = $mw->Scrolled(Canvas => -scrollbars => 'osoe', -width => 1000, -height => 400, -scrollregion => [0, 0, 1000, 400], -bg => 'green', )->pack; MainLoop;` [download]	[reply] [d/l]
Re: TK Geometry question. by Anonymous Monk on Aug 04, 2015 at 03:11 UTC
I would start with See Re^3: resizing problem with Tk appl using PackForget, Tk::Scrolled, (inside Tk::Wm sub Scrolled), inside Tk::Frame sub packscrollbars, Tk::WidgetDump, and start with #!/usr/bin/perl -- #~ #~ perltidy -olq -csc -csci=3 -cscl="sub : BEGIN END " -otr -opr -ce + -nibc -i=4 -pt=0 "-nsak=" #!/usr/bin/perl -- use strict; use warnings; use Tk qw/ tkinit /; Main( @ARGV ); exit( 0 ); sub Main { my $mw = TkMain( @_ ); $mw->WidgetDump; ## use Tk::WidgetDump; $mw->MainLoop; } ## end sub Main sub TkMain { my $mw = tkinit( -bg => 'green', ); $mw->minsize( 60, 60 ); my $top = $mw->Pane( -bg => 'orange', )->pack( -side => 'top', -expand => 0, -fill => 'x', ); my $label = $top->Label( -text => 'Label', -bg => 'pink', )->pack( qw/ -side left / ); my $cans = $mw->Scrolled( Frame => -bg => 'white', )->pack( -fill => 'both', -expand => 1, ); my $can = $cans->Canvas( -width => 300, -height => 300, -bg => 'pink', )->pack( -fill => 'none', -expand => 0, ); $top->Button( -text => 'packscrollbars', -command => [ \&unforgetScrollbars, $cans ], )->pack( qw/ -side left / ); $top->Button( -text => 'packForget scrollbars', -command => [ \&forgetSrollbars, $cans ], )->pack( qw/ -side left / ); #~ $mw->bind( '<Configure>' => [ \&gotResized , $cans ] ) ; ## too + much $mw->bind( $cans, '<Configure>' => \&gotResized ); ## ok* ## http://www.tcl.tk/man/tcl8.4/TkCmd/bind.htm $cans->Subwidget( 'xscrollbar' )->bind( '<Configure>', \&gotResize +d ) ; ## bingo? ## $xscrollbar->parent->.... return $mw; } ## end sub TkMain sub gotResized { warn "@_"; my( $cans ) = @_; } ## end sub gotResized sub unforgetScrollbars { my( $cans ) = @_; $cans->Subwidget( 'ysbslice' )->pack; $cans->Subwidget( 'corner' )->pack; $cans->Subwidget( 'yscrollbar' )->pack; $cans->Subwidget( 'xscrollbar' )->pack; $cans->packscrollbars; } ## end sub unforgetScrollbars sub forgetSrollbars { my( $cans ) = @_; $cans->Subwidget( 'ysbslice' )->packForget; #~ $cans->Subwidget( 'corner' )->packForget; $cans->Subwidget( 'yscrollbar' )->packForget; $cans->Subwidget( 'xscrollbar' )->packForget; } ## end sub forgetSrollbars __END__ [download]	[reply] [d/l]