Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Perl Tk Resize Question

by Anonymous Monk
on Oct 30, 2006 at 15:03 UTC ( [id://581309]=perlquestion: print w/replies, xml ) Need Help??

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

Dear all,

I am writing a Perl-Tk application, and need to handle the resizing of Tk::Canvas object. I know I can do that with a binding to the `Configure' event, but that will not do for my problem, because the contents of the canvas takes quite a lot of time to redraw.
Therefore, what I would like to do is to wait for the user to finish his resizing ( that is when Button-1 is released ) and then redraw everything.
I have not managed to do that, using bindings to `Configure' and `ButtonRelease-1'.

Any ideas ?

Thanks,

Philippe

Replies are listed 'Best First'.
Re: Perl Tk Resize Question
by zentara (Archbishop) on Oct 30, 2006 at 17:11 UTC
    You need to resort to some using some flags and tricks. First, you will need to pack your canvas with -fill=>0, and -expand=>1 so it won't automatically resize. Then when you detect a $mw resize, resize your canvas manually. Here is a way to detect when a resize finishes. I'm sure there is a more refined way, but I don't feel like hacking for it. :-) By the way, if you are having trouble resizing automatically, there may be some other problem in your code. This requires you to right click on the $mw after you finished resizing.

    P.S. The reason your Button-1-Release dosn't work, is because you are NOT in the $mw when you do a resize, you are doing a WINDOWMANAGER event. So you have to realize your mouse is not in the Tk window anymore, during a resize.

    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = new MainWindow; my $current_size = $mw->reqwidth . "x" . $mw->reqheight; my $old_current_size = $current_size; my $canvas = $mw->Canvas(-width => 300, -height => 300, -bg => 'black', )->pack(); $mw->bind( '<Configure>', sub{ &OnResize }); my $leave = 0; $mw->bind( '<Leave>',sub { $leave = 1; } ); $mw->bind( '<Enter>',sub { $leave = 0; &OnResize; } ); $mw->bind( '<3>',sub { print "1\n"; my $width = $mw->width - 10; my $height = $mw->height - 10;; $canvas->configure(-width=> $width, -height => $height); $mw->update; } ); MainLoop; sub OnResize { my $current_size = $mw->width . "x" . $mw->height; if( $leave == 1) {return } if($old_current_size eq $current_size){return} ## Resize has occurred do something: printf( "Resize happened - old size: %s, new size: %s\n", $old_current_size, $current_size ); ## set the old size to the new size $old_current_size = $current_size; }

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
Re: Perl Tk Resize Question
by capfan (Sexton) on Nov 21, 2020 at 10:30 UTC

    I had the same issue today and found this thread. Yes, it is old, but I would like to add another solution in case someone needs it.

    You can use a timer to wait for a moment before you do the resize. Cancel the timer if the MainWindow resizes again within a certain time and start it anew.

    Sample code:

    #!perl use strict; use warnings; use Tk; use v5.16; # Skript zum manuellen resizen der Canvas nach Änderung der Größe des +MainWindow. # Man muss nochmal einen Rechtsklick machen. # Quelle: https://www.perlmonks.org/bare/?node_id=581309, abgerufen 20 +20-11-21 my $mw = Tk::MainWindow->new; my $current_size = $mw->reqwidth . "x" . $mw->reqheight; my $old_current_size = $current_size; my $canvas = $mw->Canvas( -width => 300, -height => 300, -bg => 'black', )->pack(); $canvas->update; # important to call this before binding <configure> e +vent my $after_resize_timer_id; $mw->bind('<Configure>' => sub { say "MW resized"; # reset timer again, if it was set $mw->afterCancel($after_resize_timer_id) if defined $after_resize_ +timer_id; # set timer # if MW doesn't resize again within a second or so, resize Canvas # if it does, reset timer to wait for a second or so $after_resize_timer_id = $mw->after(500, sub{ say "Update canvas"; my $width = $mw->width; my $height = $mw->height; $canvas->configure(-width => $width, -height => $height); $canvas->update; }); }); $mw->MainLoop; exit(0);
Re: Perl Tk Resize Question
by liverpole (Monsignor) on Oct 30, 2006 at 16:05 UTC

        I have not managed to do that, using bindings to `Configure' and `ButtonRelease-1'.

    In what way has it failed?  Please show the program you're using (or, if it's large, please show the smallest subset of the program that still demonstrates the problem).

    It will also help to say how exactly it's failing; ie. what results you're getting, in contrast to what results you'd like to get.

    The reason we need to know the results you're getting is that your program may not be failing for everyone who tries it.

    The reason we need to know what results you'd like to get is that, without those, how can we know when we've achieved "success"?


    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://581309]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (3)
As of 2024-04-25 07:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found