miau's blog?

クリップボードの画像を PNG ファイルとして保存

システム開発をやってると「エビデンス」と称してスクリーンショットを撮ったりすることが多々あります。Web ページのスクリーンショットを撮るのであれば専用のソフトが多数あるわけですが、証拠としてアドレスバーも入れておきたい場合、結局普通のキャプチャツールを使うことになります。

こういう場合、私は大抵 EasyShot を使って yyyymmddhhmiss.png として保存してるんですが、今日取得したかった画面はやたら横長い画面。マルチディスプレイで 2 画面使って表示して、やっと画面内に収まるくらいのもの。EasyShot はマルチディスプレイに対応していないので、プライマリディスプレイに表示された範囲しかキャプチャしてくれません。WinShot も試したけど同じみたい。

「Alt + PrintScreen で良くね?」というアドバイスがあって思い出したのが、 Clippic。これと組み合わせれば次々と PNG ファイル作れるかな?と期待したんだけど、キーボードで操作できないとどうにも。あと毎回ファイル名聞かれるのでさくさく操作できない。

じゃあ Perl で自分好みのやつを作ってしまえ、ということで。作ってみました。




■完成品


=head1 NAME

clip2png.pl - クリップボードの内容を PNG ファイルとして保存する

=head1 DESCRIPTION

クリップボードの内容を yyyymmdd-hhmiss.png として保存します。

=cut

use strict;
use warnings;

use Win32::Clipboard;
use Image::Magick;

# .png の保存先
my $png_path = 'E:/captured';

# クリップボードから画像(CF_DIB)の抽出
my $CLIP = Win32::Clipboard();
my $image = $CLIP->GetBitmap() or die "Clipboard hasn't CF_DIB data";

# 一旦 BMP ファイルに保存
my $bmpfile = 'tmp.bmp';
open BMP, '>', $bmpfile or die "can't open bmpfile: $!";
binmode(BMP);
print BMP $image;
close BMP;

# BMP ファイルから読み込み
my $p = new Image::Magick;
my $x = $p->Read($bmpfile);
die "$x" if "$x";
close BMP;

unlink $bmpfile;

# PNG ファイルとして保存
my ($sec, $min, $hour, $mday, $month, $year) = localtime();
my $pngfile = sprintf(
"$png_path/%04d%02d%02d-%02d%02d%02d.png",
$year+1900, $month+1, $mday, $hour, $min, $sec);

$x = $p->Write(filename => $pngfile, compression => 'None');
die "$x" if "$x";


Image::Magick を使っているので、ここ から Win32 用の DLL をダウンロードして、ActivePerl のオプションつきでインストールしてください。

これだけだと DLL のリンクエラー(?)になってしまうので、C:\Program Files\ImageMagick-6.3.3-Q16\ から .pl の同階層に下記をコピーして使いました。

CORE_RL_bzlib_.dll
CORE_RL_jpeg_.dll
CORE_RL_lcms_.dll
CORE_RL_magick_.dll
CORE_RL_png_.dll
CORE_RL_tiff_.dll
CORE_RL_ttf_.dll
CORE_RL_zlib_.dll
X11.dll

もっと正攻法っぽいやり方あると思うんだけど、どうすればいいんだろ?

■さらに使いやすくするために

AutoHotKey で、

!ScrollLock::Run E:\Programming\Perl\clip2png\clip2png.pl

みたいにしておけば「Alt + PrintScreen」→「Alt + ScrollLock」という感じでさくっとファイル保存までできるので、ストレス溜まりません。

■引っかかった部分

・Win32::Clipboard で CF_BITMAP のフォーマットを扱おうとすると、なぜか落ちる。結局必要なのは CF_DIB だったから良かったけど、ちょっと気持ち悪い。

・初めは ImageMagick じゃなくて GD でやろうとしてたんだけど、GD では bitmap データ扱えないらしい。ので結局 ImageMagick でやりました。

・Image::Magick の Read でファイルハンドルが扱えないっぽい。本当は一時ファイルなんて作らずに、

my $p = new Image::Magick;
open BMP, '<', \$image or die "can't open BMP: $!";
binmode BMP;
my $x = $p->Read(file => \*BMP);
die "$x" if "$x";

 とやりたかったけど、これまた落ちる。原因は
 
 PerlMagick Filehandle から Read できない - fj.comp.lang.perl | Google Groups
 
 に載ってて、Windows 環境特有の問題らしい。


30 分くらいでできると思ったのに予想外に時間取られたから、今日は仕事の進みが遅かった・・・。
で、悔しいから blog ネタにするパターン。


(2007-10-04 追記)

今日↑のスクリプトを別の PC で動かそうとしたら、こんなエラーになった。

perl.exe - エントリ ポイントが見つかりません
プロシージャ エントリ ポイント Perl_newXS_flags が
ダイナミック リンク ライブラリ perl58.dll から見つかりませんでした。

どうも use Image::Magick しただけで落ちてるっぽいけど・・・?

と、ググってみるとあっさり解決策発見。

Re: on Perl_newXS_flags error :: ASPN Mail Archive :: perl-win32-users - Microsoft Internet Explorer

Looks like that entry exists in the build 822 perl58.dll - so upgrading to
build 822 might be the easiest solution.

だそうで。ActivePerl の最新版(5.8.8.822)入れたら解決しました。(5.8.8.820 ではダメでした。)
posted at 20:17:29 on 2007-03-12 by miau - Category: Perl No Trackbacks - Permalink

TrackBack

このエントリにトラックバックはありません
現在トラックバックは受け付けていません。

Comments

No comments yet

Add Comments

現在コメントは受け付けていません。
お手数ですが、 こちら のコメント欄にでも記載していただければと思います。