Tk Screen and Canvas Screenshots

[zentara]

One of the most asked questions in Tk is "how do I print out my canvas, or at least get a screenshot?" Well the answers I've always seen is export it using the "postscript function". Well, that is trickier to use than one would hope for.

Here is a simple demo of grabbing screenshots of the root window, the mainwindow, and just the canvas. It is linux only and uses Tk::WinPhoto, a basic part of Tk.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::WinPhoto;
use Tk::JPEG;

my $mw = tkinit;

my $canv = $mw->Canvas(width => 300, height => 200)->pack();
# Create line inside the canvas  
$canv->create ('line',1, 1, 100, 100, -fill=>'red');

$canv->createRectangle(10,20,30,40, -fill=>'blue' );

my $fullbutton = $mw->Button(-text=>'Full Screen Capture',
                             -command => \&full_capture,
                            )->pack;

my $mainbutton = $mw->Button(-text=>'MainWindow Capture',
                             -command => \&mw_capture,
                            )->pack;

my $canvbutton = $mw->Button(-text=>'Canvas Capture',
                             -command => \&canv_capture,
                            )->pack;


MainLoop;

sub full_capture{

my @id = grep{$_ =~ 'Window id'} split("\n",`xwininfo -root`);
my @ids = split(' ',$id[0]);
(my $id) = grep{$_ =~ /0x/} @ids;

my $image = $mw->Photo(-format => 'Window',
#                    #    -data => oct($mw->id) 
#                    #    -data =>  oct('0xa00022') 
                          -data =>  oct($id)
                       );

my $pathname = './rootwindow.'.time.'.jpg';
$image->write($pathname, -format => 'JPEG');

}

######################################################### 
sub mw_capture{

my $image = $mw->Photo(-format => 'Window',
                        -data => oct($mw->id)
#                    #  -data =>  oct('0xa00022') 
                     #  -data =>  oct($id) 
                       );

my $pathname = './mainwindow.'.time.'.jpg';
$image->write($pathname, -format => 'JPEG');

}
########################################################## 

sub canv_capture{

my $image = $mw->Photo(-format => 'Window',
                        -data => oct($canv->id)
                       );

my $pathname = './canvas.'.time.'.jpg';
$image->write($pathname, -format => 'JPEG');

}
##############################################################

[kragen]

That's pretty clever. I didn't know about this Window format for Photo. Is it new?

PNG might be a better choice than JPEG for storing Canvas screenshots; Canvases are likely to contain large areas of solid color and sharp color boundaries, which PNG handles beautifully and JPEG handles terribly.

[zentara]

No it's not new, its just buried way down in Mastering PerlTk's chapter on images. It's been in TCL for along time. I guess people just havn't discovered it's full usefulness.

Maybe the ease of ImageMagick's import program, has prevented more people from digging around for it. It's best use is to grab screenshots of Tk sub-widgets like a Canvas. Import won't do that without "rectangular-mouse-selection" which is kind of "inexact". And Canvas's export to postscript function has some glitches, especially when individual postscript elements are not visible. A straight pixmap shot is so much cleaner.

Just put "use Tk::PNG;" at the top, and adjust the code accordingly to get png snapshots.

[Anonymous Monk]

I'm using this and it works great. Thanks! However, it only captures the part of the Canvas that is currently displayed. If I've drawn outside that area and expanded the Canvas such that I need to use the scrollbars in order to see the full image, how can I get a capture of the full scrollable image and not just the currently displayed portion? Thanks.

[zentara]

Use tha bbox('all') and the postscript capture, then convert it to whatever you want.

$mw->Button(
    -text    => "Save PS",
    -command => [sub {
         $canv->update;
         my @capture=();
         my ($x0,$y0,$x1,$y1)=$canv->bbox('all');
         print "$x0,$y0,$x1,$y1\n";

         @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-$x
+0);
         $canv->postscript(-colormode=>'color',
                              -file=> "$0.ps",
                   -rotate=>0,
                   -width=>2400,
                   -height=>3400,    
                   @capture);
                               
    system("convert $0.ps $0.png");          
      } 
  ]  )->pack;