]>
Commit | Line | Data |
---|---|---|
b2239557 TC |
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; | |
dcdbb706 TC |
15 | my $mw; |
16 | eval { | |
17 | $mw = Tk::MainWindow->new; | |
18 | }; | |
19 | $@ and plan skip_all => 'Cannot create a window in Tk'; | |
b2239557 TC |
20 | |
21 | $mw->windowingsystem eq 'win32' | |
22 | or plan skip_all => 'Tk windowing system not Win32'; | |
23 | ||
24 | plan tests => 1; | |
25 | ||
26 | $mw->Label(-text => "test: $0")->pack; | |
27 | $mw->after(100 => | |
28 | sub { | |
29 | $im = screenshot(widget => $mw) | |
30 | or print "# ", Imager->errstr, "\n"; | |
31 | $mw->destroy; | |
32 | }); | |
33 | MainLoop(); | |
34 | ok($im, "grab from a Tk widget"); | |
35 |