Re: Scaling an image with Gtk2::Gdk::Pixbuf->scale

[Eric Cashon via gtk-perl-list]

 

 Hi Les,


See if this works better for the cat.


Eric


#!/usr/bin/perl
package scaleme;
 
use strict;
use diagnostics;
use warnings;
 
use Gtk2 '-init';
use Glib qw(TRUE FALSE);
 
# Display this image
my $path = 'cat.png';
 
# Open a Gtk2 window with a Gtk2::TextView
my $window = Gtk2::Window->new('toplevel');
$window->set_title('scaleme');
$window->set_position('center');
$window->set_default_size(800, 600);
$window->signal_connect('delete-event' => sub {
    Gtk2->main_quit();
    exit;
});
            
my $frame = Gtk2::Frame->new();
$window->add($frame);
 
my $scrollWin = Gtk2::ScrolledWindow->new(undef, undef);
$frame->add($scrollWin);
$scrollWin->set_policy('automatic', 'automatic');     
$scrollWin->set_border_width(0);
 
my $textView = Gtk2::TextView->new;
$scrollWin->add_with_viewport($textView);
 
if (-e $path) {
 
    # Display a photo of a cat face
    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file($path);
 
    my $buffer = $textView->get_buffer();
    $buffer->insert_pixbuf(
        $buffer->get_end_iter(),
        $pixbuf,
    );
 
    # Make the overall image 20% bigger, but the cat's face is its
    #   original size (and centred in the middle)
    my $factor = 0.2;   
    my $w = $pixbuf->get_width();
    my $h = $pixbuf->get_height();
    my $scale_w1 = $w * 1.2;
    my $scale_h1 = $h * 1.2;
 
    my $pixbuf2 = $pixbuf->scale_simple($scale_w1, $scale_h1, 
'GDK_INTERP_BILINEAR');

    $buffer->insert_pixbuf(
        $buffer->get_end_iter(),
        $pixbuf2,
    );

   my $pixbuf3 = Gtk2::Gdk::Pixbuf->new(
        'GDK_COLORSPACE_RGB',
        FALSE,
        $pixbuf->get_bits_per_sample(),
        $scale_w1,
        $scale_h1,
    );
   $pixbuf3->fill(0xFF00FFFF);

   my $move_x = ($scale_w1 - $w) / 2;
   my $move_y = ($scale_h1 - $h) / 2;

   $pixbuf->composite($pixbuf3, $move_x, $move_y, $w, $h, $move_x, $move_y, 1, 
1, 'GDK_INTERP_BILINEAR', 255);

   $buffer->insert_pixbuf(
        $buffer->get_end_iter(),
        $pixbuf3,
    );

}
 
$window->show_all();   
Gtk2->main();



_______________________________________________
gtk-perl-list mailing list
gtk-perl-list@gnome.org
https://mail.gnome.org/mailman/listinfo/gtk-perl-list