Delphi 6 ローテクTips/マウスカーソルをキャプチャ

デスクトップのキャプチャソフトを作っていてマウスカーソルもキャプチャしたいと思いました。
色々調べてマウスカーソルをキャプチャするには現在のマウスカーソルの状態を取得して自分で描画するのが定石なようでした。

参考サイト

C#またはDelphiでカーソル付きでスクリーンキャプチャし、ちょっ.. - 人力検索はてな

http://q.hatena.ne.jp/1213429698

[HSP3] スクリーンショット時にマウスカーソルも表示 We aren't android!

http://blog.tkooler.net/Entry/72/

ＤＥＫＯのざつだん。

http://ht-deko.minim.ne.jp/ft0202.html

GetIconInfo Function

http://msdn.microsoft.com/ja-jp/library/ms648070.aspx

>GetIconInfo creates bitmaps for the hbmMask and hbmColor members of ICONINFO.
>The calling application must manage these bitmaps and delete them when they are no longer necessary.

引用にあるようにGetIconInfo APIは二つのビットマップを作ります。
それがICONINFO構造体のhbmMaskとhbmColorです。
このビットマップは使い終わったら削除しなければならないのですが、その責任はGetIconInfo APIを呼び出したアプリケーション側にあります。
ということでGetIconInfo APIを呼び出したら必ずDeleteObject APIを使ってこの二つのビットマップを解放しないとなりません。

はてなでの質問にあるようにGetCursorInfo APIでマウスカーソルの情報を取得します。
取得した情報中のhCursorをDrawIconExに渡してキャンバスに描画させることで現在のマウスカーソルの画像を取得できます。
単純にカーソルの形状を取得したいだけならこれで良いのですが、デスクトップのスクリーンショットに重ね合わせたい場合はホットスポット分を調整しないとずれてしまいます。
そのためGetIconInfo APIでマウスカーソルのホットスポットを取得し、DrawIconExにカーソルの位置を渡す時にその分を調整します。
マウスカーソルの情報を得るのにGetIconInfo APIを使うというのは正直「？」な感じがするのですが、どうもアイコンとマウスカーソルというのは同じようなフォーマットのものなのだそうです。

GetIconInfo APIで取得したTIconInfo構造体中のhbmMaskとhbmColorの二つのビットマップは使用しないので早々に解放します。
これを忘れるとリソース不足の深刻なエラーを招きます。
1回や2回、、いやもっと多くて何十回程度忘れたくらいではいまどきのOSならびくともしないのでしょうが、タイマーを使って画面キャプチャを行ったりして長時間連続でマウスキャプチャを行っているのに解放し忘れているとえらいことになります。
…私はなりました。

procedure gpcMouseCursorDraw(ABitmap : TBitmap; iX, iY : Integer);
//ABitmapのiXとiYの位置に現在のマウスカーソルを描画する
{ TODO : 2000でのマウスカーソルのキャプチャ }
var
l_CursorInfo : TCursorInfo;
l_IconInfo : TIconInfo;
begin
//http://q.hatena.ne.jp/1213429698
//http://blog.tkooler.net/Entry/72/
//http://ht-deko.minim.ne.jp/ft0202.html
FillChar(l_CursorInfo, SizeOf(l_CursorInfo), 0);
l_CursorInfo.cbSize := SizeOf(l_CursorInfo);
GetCursorInfo(l_CursorInfo);

FillChar(l_IconInfo, SizeOf(l_IconInfo), 0);
l_IconInfo.fIcon := False; //取得するのはカーソル
GetIconInfo(l_CursorInfo.hCursor, l_IconInfo);
//http://msdn.microsoft.com/ja-jp/library/ms648070.aspx
//2011-04-22:hbmMaskとhbmColorは解放しないとリソースが足りなくなる深刻なエラーに陥る
DeleteObject(l_IconInfo.hbmMask);
DeleteObject(l_IconInfo.hbmColor);

if (l_CursorInfo.flags = CURSOR_SHOWING) then begin
//カーソルは表示されている
DrawIconEx(
ABitmap.Canvas.Handle,
iX - Integer(l_IconInfo.xHotspot),
iY - Integer(l_IconInfo.yHotspot),
l_CursorInfo.hCursor,
GetSystemMetrics(SM_CXCURSOR),
GetSystemMetrics(SM_CYCURSOR),
0,
0,
DI_NORMAL
);
end;
end;