t/40tkwin32.t

   1 #!perl -w
   2 use strict;
   3 use Test::More;
   4
   5 use Imager::Screenshot 'screenshot';
   6
   7 Imager::Screenshot->have_win32
   8   or plan skip_all => "No Win32 support";
   9
  10 eval "use Tk;";
  11 $@
  12   and plan skip_all => "Tk not available";
  13
  14 my $im;
  15 my $mw;
  16 eval {
  17   $mw = Tk::MainWindow->new;
  18 };
  19 $@ and plan skip_all => 'Cannot create a window in Tk';
  20
  21 $mw->can('windowingsystem')
  22   or plan skip_all => 'Cannot determine windowing system';
  23
  24 $mw->windowingsystem eq 'win32'
  25   or plan skip_all => 'Tk windowing system not Win32';
  26
  27 plan tests => 1;
  28
  29 $mw->Label(-text => "test: $0")->pack;
  30 $mw->after(100 =>
  31            sub {
  32              $im = screenshot(widget => $mw)
  33                or print "# ", Imager->errstr, "\n";
  34              $mw->destroy;
  35            });
  36 MainLoop();
  37 ok($im, "grab from a Tk widget");
  38