マウスカーソルの影は,レイヤード ウィンドウです.
マウスカーソル本体と,影の 2 つのウィンドウで構成されています.
[レイヤード ウィンドウ]
http://msdn.microsoft.com/ja-jp/library/ms997507.aspx#layerwin_topic2
マウスカーソルの「影」はアルファシャドウ,つまり半透明です.
Delphi 2007 以前の Delphi でこれをキャプチャ (作成) するには,
アルファチャンネルの機能を実装した TBitmap が必要となります.
次のコードは,Delphi 2009 以降専用です.
実行して,ボタンをクリックすると,5 秒儀に,現在のマウスカーソルを TImage に描画します.
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type TForm1 = class(TForm) Button1: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); private { Private 宣言 } procedure DrawMouseCursor(ACanvas: TCanvas; ALeft, ATop : Integer); public { Public 宣言 } end;
var Form1: TForm1;
implementation
uses MMSystem;
{$R *.dfm}
//============================================================================= // マウスカーソルの影付きキャプチャ // このフォーム上のTImageに描画 //============================================================================= procedure TForm1.Button1Click(Sender: TObject); var StartTime : DWORD; begin Image1.Picture.Assign(nil);
//指定時間が経過したらキャプチャ開始 Starttime := timeGetTime; while (timeGetTime - StartTime) < 5000 do begin Sleep(100); Application.ProcessMessages; end;
DrawMouseCursor(Image1.Canvas, 0, 0); end;
//----------------------------------------------------------------------------- // マウスカーソルのマスク画像の処理専用(マウスカーソルの影部分) // // 与えられたビットマップのピクセル[0, 0]と同じ色のピクセルを透明化する // それ以外のピクセルは,透過度をOpadityで指定する値にする // // ABitmap : 処理対象のビットマップ.処理したビットマップを返す //----------------------------------------------------------------------------- procedure ShadowMouseCursorBitmapToTransparent(ABitmap: TBitmap; Opacity: Byte); type TRGBQArray = array [0..255] of RGBQUAD; PRGBQArray = ^TRGBQArray; var TransColor : TColor; TransR : Byte; TransG : Byte; TransB : Byte; R : Byte; G : Byte; B : Byte; Y : Integer; X : Integer; ScanArray : PRGBQArray; ColorQuad : RGBQUAD; begin //32bitのビットマップにし,AlphaFormatの値をafDefinedにする ABitmap.PixelFormat := pf32bit; ABitmap.AlphaFormat := afDefined;
//指定色のR,G,Bの各値を取得しておく TransColor := ABitmap.Canvas.Pixels[0, 0]; TransR := GetRValue(TransColor); TransG := GetGValue(TransColor); TransB := GetBValue(TransColor);
for Y := 0 to ABitmap.Height - 1 do begin ScanArray := ABitmap.ScanLine[Y];
for X := 0 to ABitmap.Width - 1 do begin
R := ScanArray[X].rgbRed; G := ScanArray[X].rgbGreen; B := ScanArray[X].rgbBlue;
if (TransR = R) and (TransG = G) and (TransB = B) then begin ColorQuad.rgbBlue := 0; ColorQuad.rgbGreen := 0; ColorQuad.rgbRed := 0; ColorQuad.rgbReserved := 0; end else begin ColorQuad.rgbRed := R; ColorQuad.rgbGreen := G; ColorQuad.rgbBlue := B; ColorQuad.rgbReserved := Opacity; end; ScanArray[X] := ColorQuad; end; end; end;
//============================================================================= // ACanvasのCanasにマウスカーソルを描画する //============================================================================= procedure TForm1.DrawMouseCursor(ACanvas: TCanvas; ALeft, ATop : Integer); var ACursorPos : TPoint; ACursorInfo : TCursorInfo; AIconInfo : TIconInfo; bmpMouse : TBitmap; begin //マウスカーソルを描画するビットマップ作成 //アルファチャネルによる透明化処理をするので,AlphaFormat := afDefined;とする bmpMouse := TBitmap.Create; bmpMouse.AlphaFormat := afDefined; bmpMouse.PixelFormat := pf32bit; bmpMouse.Width := GetSystemMetrics(SM_CXCURSOR); bmpMouse.Height := GetSystemMetrics(SM_CYCURSOR);
//カーソルの位置を取得 GetCursorPos(ACursorPos); ACursorInfo.cbSize := SizeOf(TCursorInfo); //現在のカーソルを指定 ACursorInfo.flags := CURSOR_SHOWING; //現在のマウスカーソルとアイコンとしての情報を取得 //ユーザが独自に作成したカーソルもキャプチャ可能となる GetCursorInfo(ACursorInfo); GetIconInfo(ACursorInfo.hCursor, AIconInfo);
try //DI_MASKにして黒いマウスカーソルの画像を取得してビットマップに描画 DrawIconEx(bmpMouse.Canvas.Handle, 2, 0, ACursorInfo.hCursor, 0, 0, 0, 0, DI_MASK); //背景を,アルファチャンネルの値を0にし,それ以外は半透明化する ShadowMouseCursorBitmapToTransparent(bmpMouse, 50); //それをキャプチャしたビットマップに描画する ACanvas.Draw(ALeft + 2, ATop + 1, bmpMouse);
//マウスカーソルを重ね描画する DrawIconEx(ACanvas.Handle, ALeft, ATop, ACursorInfo.hCursor, 0, 0, 0, 0, DI_DEFAULTSIZE or DI_NORMAL); finally FreeAndNil(bmpMouse); //AIconInfoが作成したビットマップを解放 DeleteObject(AIconInfo.hbmMask); DeleteObject(AIconInfo.hbmColor); end; end;
end.
動作確認環境は,Windows 7 U64(SP1) + Delphi XE Pro です.
|