0.014 release
[imager-screenshot.git] / t / 10win32.t
CommitLineData
0ddb7051
TC
1#!perl -w
2use strict;
3use Test::More;
4
62b84c46
TC
5# you might be looking at this test code and wondering why it doesn't
6# try to check the images themselves - the reason is that in many
7# cases the build and tests are being done in an automated build, and
8# it may be possible that the user is running a screensaver, which
9# will be what's returned instead of what we expect.
10#
11# this applies for the sub-image tests too, since the screen saver may
12# have changed the screen between the two grabs
13
0ddb7051
TC
14use Imager::Screenshot 'screenshot';
15
16Imager::Screenshot->have_win32
17 or plan skip_all => "No Win32 support";
18
cc67afb5 19plan tests => 15;
0ddb7051
TC
20
21{
22 my $im = screenshot(hwnd => 0);
23
24 ok($im, "got a screenshot");
62b84c46
TC
25
26 # check the size matches the tags
27 is($im->tags(name => 'ss_window_width'), $im->getwidth,
28 "check ss_window_width tag");
29 is($im->tags(name => 'ss_window_height'), $im->getheight,
30 "check ss_window_height tag");
31 is($im->tags(name => 'ss_left'), 0, "check ss_left tag");
32 is($im->tags(name => 'ss_top'), 0, "check ss_top tag");
33 is($im->tags(name => 'ss_type'), 'Win32', "check ss_type tag");
0ddb7051
TC
34}
35
36{ # as a method
37 my $im = Imager::Screenshot->screenshot(hwnd => 0);
38
39 ok($im, "call as a method");
40}
41
62b84c46
TC
42{ # try our subimage options
43 my $im = screenshot(hwnd => 0, left => 70, top => 30,
44 right => -35, bottom => -17);
45 ok($im, "call with left, top, etc");
46
47 # make sure tags set as expected
48 is($im->tags(name => 'ss_left'), 70, "check left value");
49 is($im->tags(name => 'ss_top'), 30, "check top value");
50 is($im->tags(name => 'ss_type'), 'Win32', "check ss_type");
51 is($im->tags(name => 'ss_window_width'), 70 + $im->getwidth + 35,
52 "check image width against window size");
53 is($im->tags(name => 'ss_window_height'), 30 + $im->getheight + 17,
54 "check image height against window size");
55}
cc67afb5
TC
56
57{ # full multi-monitor desktop
58 my $im = screenshot(hwnd => 0, monitor => -1);
59 ok($im, "full desktop");
60 is($im->getchannels, 4, "should have an alpha channel");
61}