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

[Les Trol]

 

Try creating a new (empty) image of the required size and then use cairo to fill it with the desired contents. The following link may help you (though it is in C and not perl, but the API is the same):

 

https://gist.github.com/bert/985903

 

I don't know any C, but as far as I can tell, the Perl equivalent of draw_in_a_GdkPixbuf.c should be something like this. (I can't tell how to make it work.)

 

 

 

#!/usr/bin/perl
package scaleme;

 

use strict;
use diagnostics;
use warnings;

 

use Gtk2 '-init';
use Glib qw(TRUE FALSE);
use Cairo;

 

# Display this image
my $path = 'change_this_directory/cat.bmp';

 

# 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) {

 

    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file($path);
    my $w = $pixbuf->get_width();
    my $h = $pixbuf->get_height();

 

    my $surface = Cairo::ImageSurface->create('argb32', $w, $h);
    my $cr = Cairo::Context->create($surface);

    # Neither of the following two lines work
#   $cr->set_source_pixbuf($pixbuf, 0, 0);
    Gtk2::Gdk::Cairo->set_source_pixbuf($cr, $pixbuf, 0, 0);
    # Continuing...
    $cr->paint();
    
    my $buffer = $textView->get_buffer();
    $buffer->insert_pixbuf(
        $buffer->get_end_iter(),
        $surface,
    );

 

    Gtk2::Gdk::Cairo->surface_destroy($surface);
    Gtk2::Gdk::Cairo->destroy($cr);
}

 

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

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