package Win32::Screenshot; use 5.006; use strict; use warnings; use Carp; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'api' => [ qw( WindowFromPoint GetForegroundWindow GetDesktopWindow GetActiveWindow GetWindow FindWindow ShowWindow GetCursorPos SetCursorPos GetClientRect GetWindowRect BringWindowToTop GetWindowText IsVisible GetTopWindow Minimize Restore ScrollWindow ) ], 'gw_const' => [ qw ( GW_CHILD GW_HWNDFIRST GW_HWNDLAST GW_HWNDNEXT GW_HWNDPREV GW_OWNER ) ], 'sw_const' => [ qw ( SW_HIDE SW_MAXIMIZE SW_MINIMIZE SW_RESTORE SW_SHOW SW_SHOWDEFAULT SW_SHOWMAXIMIZED SW_SHOWMINIMIZED SW_SHOWMINNOACTIVE SW_SHOWNA SW_SHOWNOACTIVATE SW_SHOWNORMAL ) ], 'raw' => [ qw ( JoinRawData CaptureHwndRect CreateImage PostProcessImage @POST_PROCESS ) ], 'default' => [ qw ( CaptureWindowRect CaptureWindow CaptureRect CaptureScreen ListChilds ListWindows ) ], 'pp' => [ qw ( ppResize ppOuterGlow ) ], ); $EXPORT_TAGS{all} = [ map {@$_} values %EXPORT_TAGS ]; our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = @{ $EXPORT_TAGS{'default'} }; our $VERSION = '1.20'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. my $constname; our $AUTOLOAD; ($constname = $AUTOLOAD) =~ s/.*:://; croak "&Win32::Screenshot::constant not defined" if $constname eq 'constant'; my ($error, $val) = constant($constname); if ($error) { croak $error; } { no strict 'refs'; *$AUTOLOAD = sub { $val }; } goto &$AUTOLOAD; } require XSLoader; XSLoader::load('Win32::Screenshot', $VERSION); use Image::Magick; our @POST_PROCESS; sub ppResize { my $ratio = shift || 0.74; my ($w, $h) = $_->Get('width', 'height'); $w = sprintf "%.0f", $w*$ratio; $h = sprintf "%.0f", $h*$ratio; $_->Resize(width=>$w,height=>$h,blur=>0.9,filter=>'Sinc'); } sub ppOuterGlow { my ($outer, $inner, $width) = @_; $inner ||= sprintf('#%02x%02x%02x', map {$_>>8} split (/,/, $_->Get('pixel[0,0]'))); $outer ||= 'white'; $width ||= 17; my $top = sprintf "%.0f", $width/3.4; # prepare background my ($w, $h) = $_->Get('width', 'height'); my $g = Image::Magick->new; $g->Set(size=>($w+$width).'x'.($h+$width)); $g->ReadImage('xc:'.$outer); $g->Draw( stroke=>$inner, fill=>$inner, primitive=>'rectangle', points=> join(',',$top, $top, $w+$width-$top, $h+$width-$top), ); $g->Blur(radius=>sprintf("%.0f", $width/2.8333), sigma=>3); # compose $g->Composite( image=>$_, 'x'=>sprintf("%.0f", $width/1.8888), 'y'=>sprintf("%.0f", $width/1.8888) ); return $g; } sub ListWindows () { ListChilds(GetDesktopWindow()); } sub ListChilds ($) { my $parent = shift; my $hwnd = GetWindow($parent, GW_CHILD()); my @list; while($hwnd) { my %win = ( hwnd => $hwnd, title => GetWindowText($hwnd), rect => [ GetWindowRect($hwnd) ], visible => IsVisible($hwnd), ); push @list, \%win; $hwnd = GetWindow($hwnd, GW_HWNDNEXT()); } return @list; } sub _getHwnd ($) { my $id = shift; if ( $id !~ /^\d+$/ ) { $id = FindWindow(undef, $id); } return $id; } sub _capture { CreateImage( CaptureHwndRect(@_) ); } sub CreateImage { my $image=Image::Magick->new(); $image->Set(magick=>'rgba'); $image->Set(size=>"$_[0]x$_[1]"); $image->Set(depth=>8); $image->BlobToImage($_[2]); return PostProcessImage($image); } sub PostProcessImage { my $image = shift; my $out; for my $hnd ( @POST_PROCESS ) { $_ = $image; if ( ref $hnd eq 'CODE' ) { $out = &$hnd( $image ); } else { $out = eval $hnd; } if ( ref $out eq ref $image && $out != $image ) { $image = $out; } } return $image; } sub CaptureWindowRect ($$$$$) { _capture(_getHwnd(shift), @_); } sub CaptureWindow ($) { my $id = _getHwnd(shift); my @rect = GetWindowRect($id); _capture(GetDesktopWindow(), $rect[0], $rect[1], $rect[2]-$rect[0], $rect[3]-$rect[1] ); } sub CaptureScreen () { my $id = GetDesktopWindow(); _capture($id, GetWindowRect($id)); } sub CaptureRect ($$$$) { my $id = GetDesktopWindow(); _capture($id, @_); } 1; __END__ =head1 NAME Win32::Screenshot - Capture and process the screen, window or rectangle =head1 SYNOPSIS use Win32::Screenshot; $image = CaptureRect( $x, $y, $width, $height ); $image->Write('screenshot.png'); =head1 DESCRIPTION The package utilizes some Win32 API function and L to let you capture the screen, a window or a part of it. The C functions returns a new L object which you can easily use to modify the screenshot or to store it in the file. You can define your own post processing handlers and chain them in the list. There are Perl equivalents of Win32 API functions for working with windows implemented in the package. These functions will allow easy identification of windows on the screen. =head2 Image post-processing The handler receives a reference to an Image::Magick object. If the handler returns such reference it will be used instead of the input one for further processing. It means that the handler can return completely different image. The handlers are organized in a list @POST_PROCESS. The item of the list can be a string passed to C or a code reference. The image will be passed to the handler as C<$_> for evals or C<$_[0]> for subs. If you want to modify the list just use push or direct access. @POST_PROCESS = ( 'ppResize(0.5)', sub { $_[0]->Blur(); } ); Handlers are executed starting with $POST_PROCESS[0]. The function C calls C function which manages the post-processing list. This function is called from all C functions, you don't have to call it explicitly. See chapter L for details on build-in handlers. =head1 EXPORT =over 8 =item :default C C C C C C C<@POST_PROCESS> =item :raw C C C C =item :pp C C =item :api C C C C C C C C C C C C C C C C C =item :gw_const GW_CHILD GW_HWNDFIRST GW_HWNDLAST GW_HWNDNEXT GW_HWNDPREV GW_OWNER =item :sw_const SW_HIDE SW_MAXIMIZE SW_MINIMIZE SW_RESTORE SW_SHOW SW_SHOWDEFAULT SW_SHOWMAXIMIZED SW_SHOWMINIMIZED SW_SHOWMINNOACTIVE SW_SHOWNA SW_SHOWNOACTIVATE SW_SHOWNORMAL =back =head2 Screen capture functions All these functions return a new L object on success or undef on failure. These function are exported by default. =over 8 =item CaptureRect( $x, $y, $width, $height ) Captures part of the screen. The [0, 0] coordinate is the upper-left corner of the screen. The [$x, $y] defines the the upper-left corner of the rectangle to be captured. =item CaptureScreen( ) Captures whole screen including the taskbar. =item CaptureWindow( $hwnd | $title ) Captures whole window including title and border. Pass the window handle or the window title as the function parameter. If the parameter is a number it will be used directly as a handle to identify the window, if it's something different a FindWindow( ) function will be utilized to find the handle. =item CaptureWindowRect( $hwnd | $title, $x, $y, $width, $height ) Captures a part of the window. Pass the window handle or the window title as the function parameter. If the parameter is a number it will be used directly as a handle to identify the window, if it's something different a FindWindow( ) function will be utilized to find the handle. The [0, 0] coordinate is the upper-left corner of the window. The [$x, $y] defines the the upper-left corner of the rectangle to be captured. =back =head2 Capturing helper functions Functions for working with raw bitmap data. These functions are not exported by default, import them with C<:raw> tag. =over 8 =item CaptureHwndRect( $hwnd, $x, $y, $width, $height ) The function captures the part of the screen and returns a list of ($width, $height, $screendata). Where $width and $height are the dimensions of the bitmap in pixels and $screendata is a buffer filled with RGBA (4-bytes) data representing the bitmap (Alpha is always 0xFF). =item JoinRawData( $width1, $width2, $height, $raw1, $raw2 ) The function joins two bitmaps of the same height and return the new bitmap data. =item CreateImage( $width, $height, $rawdata ) Creates a new Image::Magick object from provided data and calls all listed post-processing handlers. The function returns the processed object. =item PostProcessImage( $image ) Calls all listed post-processing handlers. The function returns the processed object. =back =head2 Post-processing handlers See L for other image processing functions. Typically you can use methods like C