Re: Tk sizing a pic to fit a window

You have a couple of beginner design errors in your code. We all went thru it. :-) First you are putting the photo into the $main window, without out setting a size for the main window, or the desired size for the photo. And the way you did it, every load, you created a new widget (which causes memory gains).

Also you really can't do what you want with just the plain Tk::Photo object (read perldoc Tk::Photo ). You can zoom or shrink, but can't set an absolute destination size. Furthermore, the Tk::Photo object won't give you the dimensions of the photo. If you had those, then you could compare your display window size to your photo size(maybe use Image::Info), then do some calculations to decide whether you need to shrink or zoom the photo, and by what factor. A big hassle. The Tk::Photo object is not that powerful. So here is a basic example to show you a shrink by 4, just to actually answer your question on resizing a Tk photo .

#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::JPEG;

my $c;

my $dir = ".";
my @fl = <*.jpg>;

print "@fl\n";

my $main = new MainWindow;

#make just 2 photo objects and reuse them, so your
#memory won't increase with every image.
# and load photo into a widget, not the main window
# let the label set the size of the window
# you could do it in the main if you want, it just
# isn't usually done like that, because you usually
# pack other things into the main window.

my $photo_obj = $main->Photo(-file => '' );
my $photo_obj_scaled = $main->Photo(-file => '' );

my $display = $main->Label(-width => 200, 
                           -height => 200,
               -image => $photo_obj_scaled,
              )->pack(-fill=>'both', -expand=>1); 

nextp();

my $nxt = $main->Button('-text' => "Next", '-command' => \&nextp)->pac
+k();

$main->Button(-text => 'exit',
              -command => sub{destroy $main}
              )->pack(-anchor => 'e');
MainLoop;


sub loadpic {
    my $filename = shift;
    my $size;
    my $orientation;
    $photo_obj->blank; #clear out old jpg
    $photo_obj_scaled->blank;
    my ($h,$w) = ($main->height, $main->width);
    #
    # how to scale the pic?

    #Tk can only zoom or shrink by a factor, so
    #you need to determine the size of the image
    #then decide whether it needs shrinking or zooming.
    #but Tk itself won't get the size of the image without
    #external modules like Image::Info 

    #I just show a shrink here, for demoing the idea.
    
    $photo_obj->read($filename); 
    $photo_obj_scaled->copy($photo_obj, -subsample => 4,4 );      
    
    $display->configure(-image => $photo_obj_scaled);

    return;
}

sub nextp {

    push (@fl,shift(@fl)); #circular list

    my $f = $fl[0];
    loadpic("$dir/$f");
    return;
}
[download]

Now you can use GD or ImageMagick to do the resizing, to an absolute size. There are some glitches to work out, like preventing stretching and maintaining aspect ratio. But this ImageMagick with Tk script, will show you the idea. There is a small glitch the way I have it setup. The first photo won't automatically display, probably because of the time it takes for ImageMagick to get setup. I used a button->invoke to get around it.

#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::JPEG;
use Image::Magick;
use MIME::Base64;

my $im = Image::Magick->new; # a single object for thumbnails
my $c;
my $dir = ".";
my @fl = <*.jpg>;
print "@fl\n";

my $main = new MainWindow;

my $photo_obj = $main->Photo(-file => '' );

my $display = $main->Label(-width => 200, 
                           -height => 200,
               -image => $photo_obj,
              )->pack(-fill=>'both', -expand=>1); 

&loadpic( $fl[0] );

my $nxt = $main->Button('-text' => "Next", '-command' => \&nextp)->pac
+k();

$main->Button(-text => 'exit',
              -command => sub{destroy $main}
              )->pack(-anchor => 'e');

# hack to make first photo show up
$main->bind("<Visibility>", sub { $nxt->invoke });

MainLoop;


sub loadpic {
    my $filename = shift;

    $photo_obj->blank; #clear out old jpg

    my ($h,$w) = ($display->height, $display->width);
    #
# how to scale the pic?
   # Create new size version
   $im->Read($filename);
   $im->Scale( geometry => $w.'x'.$h );
   #Tk needs base64 encoded image files
   my $data = encode_base64( $im->ImageToBlob() );
   undef @$im; # blank $im object 

   $photo_obj->put($data); 
   $display->configure(-image => $photo_obj);

}

sub nextp {
    push (@fl,shift(@fl)); #circular list

    my $f = $fl[0];
    loadpic("$dir/$f");
}
[download]

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

Comment on Re: Tk sizing a pic to fit a window Select or Download Code

Replies are listed 'Best First'.
Re^2: Tk sizing a pic to fit a window by cormanaz (Deacon) on Mar 19, 2006 at 19:56 UTC
Dude, thanks! That was a giant help. I didn't know you could use Image::Magick and Tk togehter. Steve	[reply]