Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年07月04日] [更新 2018年03月17日]　Delphi サンプルプログラム集
094_マウスカーソル画像ファイルの作成
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
094_ConvertToMouseCursor.zip　[8,869 KB]　2018年03月17日版 (EXE 同梱)




  • 2018年01月22日 (これより前の履歴は省略)
  • [163_コンポーネントのアイコン作成支援プログラム] にマウス用カーソルファイルの保存機能を追加したので，ホットスポットを GUI 操作で行うサンプルの掲載と添付を中止



各種の画像形式からマウスカーソルの画像ファイルを作成


拡張子が .cur のマウスカーソルは CreateIconIndirect 関数を使用して作成できます．この関数の引数は 1 つだけで IconInfo 構造体です．Delphi では TIconInfo レコード型です．この関数はアイコンの作成にも使用します．いずれもビットマップから作成します．
JPEG, GIF, PNG, ICO 形式の画像はビットマップ形式の画像に変換できますから，これらの形式の画像からも CreateIconIndirect 関数を施用してアイコン画像を作成することになります．

この関数で作成するマウスカーソル画像の色数等は Windows のシステムによって決まります．Windows 7 の場合は基本的に 32 ビットのアルファチャンネル付きの画像となります．

アイコンの作成と違うのは，マウスカーソルではホットスポットの設定が必要なことです．ホットスポットはマウスのクリック位置を指定する画像上の座標のことです．




図1
マウスカーソルのホットスポットの例
  • 指先の赤い点がマウススポット
  • このマウスカーソルは Windows 7 のもの


[備考 1]
Windows 7 で使用されているマウスカーソルのファイルは，デフォルトでは C:\Windows\Cursors のフォルダ内にあります．

[備考 2]
Delphi 7 等の旧い Delphi には各種の形式の画像が作成，編集可能なイメージエディタが付属していましたが，現在の Delphi にはこのようなイメージエディタは付属していません．

[備考 3]
本ページでは，以下のサイトからダウンロードした PNG 形式のアイコン画像を利用しています．





01_ビットマップ画像からマウスカーソル画像ファイルを作成


下に示すコードはネット上によく掲載されている，ビットマップからマウスカーソルを作成するサンプルです．このコードで作成して保存したマウスカーソルは，その画像を読み出してカーソルを表示しても，マウスカーソルとして機能しますが，ホットスポットの値が指定通りにはなりません．




図2
作成したマウスカーソルの画像
  • 赤い四角形がホットスポットの座標
  • ホットスポットの値が (0, 0) になってしまう
  • (0, 0) は左上の座標

リスト1
ホットスポットの設定が有効にならないコード		 
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgFilePath : string;
  LBitmap      : TBitmap;
  LMaskBitmap  : TBitmap;
  LIcon        : TIcon;
  LIconInfo    : TIconInfo;
begin
  LImgFilePath := 'billiard_marker.bmp';

  LIcon       := TIcon.Create;
  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(LImgFilePath);
    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LMaskBitmap.Canvas.Pixels[0, LMaskBitmap.Height - 1]);

    LIconInfo.fIcon    := False;
    LIconInfo.xHotspot := 15;
    LIconInfo.yHotspot := 15;
    LIconInfo.hbmMask  := LMaskBitmap.Handle;
    LIconInfo.hbmColor := LBitmap.Handle;
    LIcon.Handle := CreateIconIndirect(LIconInfo);

   LIcon.SaveToFile(ChangeFileExt(LImgFilePath,'.cur'));
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
  end;
end;


作成したマウスカーソルのハンドルを TIcon のハンドルに代入しないで，以下のように，直接マウスカールとして使用すれば，ホットスポットの設定は有効です．


リスト2
作成したマウスカーソルを画像として保存しないで使用する例
TIcon を使用しなければホットスポットの設定は有効		 
const
  crMYCursor = 1;

//=============================================================================
//  CreateIconIndirect関数を使用してビットマップからマウスカーソルを作成
//
//  TIcon.Handleにセットしなければ設定したホットスポットは有効
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgFilePath : string;
  LBitmap      : TBitmap;
  LMaskBitmap  : TBitmap;
  LIconInfo    : TIconInfo;
begin
  LImgFilePath := 'billiard_marker.bmp';

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(LImgFilePath);
    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LMaskBitmap.Canvas.Pixels[0, LMaskBitmap.Height - 1]);

    LIconInfo.fIcon    := False;
    LIconInfo.xHotspot := 15;
    LIconInfo.yHotspot := 15;
    LIconInfo.hbmMask  := LMaskBitmap.Handle;
    LIconInfo.hbmColor := LBitmap.Handle;

    //TScreen.Cursorsプロパティにセット
    Screen.Cursors[crMYCursor] := CreateIconIndirect(LIconInfo);

    //使用するカーソルを設定
    Screen.Cursor := crMYCursor;
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
  end;
end;



02_作成したマウスカーソルのホットスポットの値を確認


アイコンとマウスカーソルはデータ構造が同じです．設定内容はアイコンヘッダと ICONDIRENTRY 構造体のメンバの値を調べることで確認できます．以下は実際に確認した使用したコードです．

アイコンヘッダのファイルの種類の値が 1 になっています．1 はアイコンを意味します．マウスカーソルの場合は 2 です．また，ホットスポットの値も (0, 0) になっていることが確認できます．
マウスカーソルの場合，wPlanes メンバに X 座標のホットスポットの値，wBitCount に Y 座標のホットスポットの値が格納されることになっています．　



[備考]
本サンプルは，マウスカーソルを画像として保存する前の確認です．保存進みのマウスカーソルのホットスポットは，TIconInfo を使用して確認できます．



図3
設定の確認結果
  • ファイルの種類が 1 のアイコンになっている
  • 本当は 2, 15, 15 になるべき

リスト3
作成したマウスカーソルの設定を確認するためのコード		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  //各アイコンの情報用レコード型
  //カーソルの場合はこのデータが1つだけ
  PIconDirEntry = ^TIconDirEntry;
  TIconDirEntry = packed record
    hWidth        : Byte;
    hHeight       : Byte;
    bColorCount   : Byte;
    bReserved     : Byte;
    wPlanes       : Word;
    wBitCount     : Word;
    dwBytesInRes  : DWORD;
    dwImageOffset : DWORD;
  end;

  //アイコンファイルのヘッダ部
  //カーソルファイルも同じ
  PIconFileHeader = ^TIconFileHeader;
  TIconFileHeader = packed record
    idReserved : Word;
    idType     : Word;
    idCount    : Word;
    dirEntry   : TIconDirEntry;
  end;

//=============================================================================
//  CreateIconIndirectで作成したTIconの設定内容を確認する
//
//  TIConはマウスカーソルの指定をしてもアイコンにしてしまう
//  ホットスポットの値も0にしてしまう
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgFilePath : string;
  LBitmap      : TBitmap;
  LMaskBitmap  : TBitmap;
  LIcon        : TIcon;
  LIconInfo    : TIconInfo;
  LIconStream  : TBytesStream;
  LIconHeader  : TIconFileHeader;
  LText        : string;
begin
  LImgFilePath := 'billiard_marker.bmp';

  LIcon       := TIcon.Create;
  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  LIconStream := TBytesStream.Create;
  try
    LBitmap.LoadFromFile(LImgFilePath);
    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LMaskBitmap.Canvas.Pixels[0, LMaskBitmap.Height - 1]);

    //TIconInfoレコード型の値をセットしてマウスカーソルとしてアイコンを作成
    //実際にはアイコン形式となる
    LIconInfo.fIcon    := False;
    LIconInfo.xHotspot := 15;
    LIconInfo.yHotspot := 15;
    LIconInfo.hbmMask  := LMaskBitmap.Handle;
    LIconInfo.hbmColor := LBitmap.Handle;
    LIcon.Handle := CreateIconIndirect(LIconInfo);

    //TIconを保存
   LIcon.SaveToFile(ChangeFileExt(LImgFilePath,'.cur'));

    //アイコンの構造体にアクセスして設定値を調べる
    LIcon.SaveToStream(LIconStream);
    LIconStream.Position := 0;
    LIconStream.Read(LIconHeader, SizeOf(TIconFileHeader));

    LText := IntToStr(LIconHeader.idType) + sLineBreak
           + IntToStr(LIconHeader.dirEntry.wPlanes) + sLineBreak
           + IntToStr(LIconHeader.dirEntry.wBitCount);

    MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
    FreeAndNil(LIconStream);
  end;
end;

end.



03_マウスカーソルのホットスポットの設定方法


TIcon はマウスカーソルとしての設定を拒絶します．
そこで， CreateIconIndirect 関数で TIcon を作成した後に，アイコンヘッダと ICONDIRENTRY 構造体のメンバを操作してマウスカーソルの画像として使用可能にしたのが以下のコードです．



図4
作成したマウスカーソルの画像
  • 赤い四角形がホットスポットの座標
  • 設定通りの位置 (15, 15) になっている

[備考]
マルチアイコンの場合，ヘッダ部に続いてアイコンの数だけ ICONDIRENTRY 構造体のデータがありますが，マウスカーソルでは ICONDIRENTRY 構造体のデータは 1 つだけです．そこで変則的ですが，上のサンプルとこのサンプルではヘッダ部の最後にメンバとして追加しています．
ただし，カーソルファイルにもマルチカーソルファイルが存在します．


リスト4
ホットスポットの設定を有効にするマウスカーソル画像の作成コード
アルファチャンネルの処理コード付き		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure CreateAlphaMaskBitmap(MaskTBitmap: TBitmap; OriginTBitmap: TBitmap;
      X, Y: Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  //各アイコンの情報用レコード型
  //カーソルの場合はこのデータが1つだけ
  PIconDirEntry = ^TIconDirEntry;
  TIconDirEntry = packed record
    hWidth        : Byte;
    hHeight       : Byte;
    bColorCount   : Byte;
    bReserved     : Byte;
    wPlanes       : Word;
    wBitCount     : Word;
    dwBytesInRes  : DWORD;
    dwImageOffset : DWORD;
  end;

  //アイコンファイルのヘッダ部
  //カーソルファイルも同じ
  PIconFileHeader = ^TIconFileHeader;
  TIconFileHeader = packed record
    idReserved : Word;
    idType     : Word;
    idCount    : Word;
    dirEntry   : TIconDirEntry;
  end;

//=============================================================================
//  CreateIconIndirectで作成
//  アイコンファイルヘッダとICONDIRENTRY構造体のメンバに必要な値を書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgFilePath : string;
  LBitmap      : TBitmap;
  LMaskBitmap  : TBitmap;
  LIcon        : TIcon;
  LIconInfo    : TIconInfo;
  LIconStream  : TBytesStream;
  LIconHeader  : TIconFileHeader;
begin
  LImgFilePath := 'billiard_marker.bmp';

  LIcon       := TIcon.Create;
  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  LIconStream := TBytesStream.Create;
  try
    LBitmap.LoadFromFile(LImgFilePath);
    LMaskBitmap.Assign(LBitmap);

    //マスク画像を作成
    if LBitmap.PixelFormat = pf32bit then begin
      CreateAlphaMaskBitmap(LMaskBitmap, LBitmap, 0, LMaskBitmap.Height - 1);
    end else begin
      LMaskBitmap.Mask(LMaskBitmap.Canvas.Pixels[0, LMaskBitmap.Height - 1]);
    end;

    //TIconInfoレコード型の値をセットしてマウスカーソルとしてアイコンを作成
    //実際にはアイコン形式となる
    LIconInfo.fIcon    := False;
    LIconInfo.xHotspot := 15;
    LIconInfo.yHotspot := 15;
    LIconInfo.hbmMask  := LMaskBitmap.Handle;
    LIconInfo.hbmColor := LBitmap.Handle;
    LIcon.Handle := CreateIconIndirect(LIconInfo);


    //アイコンの構造体にアクセスして強制的に値を設定する
    LIcon.SaveToStream(LIconStream);
    LIconStream.Position := 0;
    LIconStream.Read(LIconHeader, SizeOf(TIconFileHeader));
    LIconHeader.idType := 2;
    LIconHeader.dirEntry.wPlanes   := 15;
    LIconHeader.dirEntry.wBitCount := 15;

    //設定したら書き込む
    LIconStream.Position := 0;
    LIconStream.Write(LIconHeader, SizeOf(TIconFileHeader));

    //設定内容を書き込んだメモリストリームを保存する
    LIconStream.Position := 0;
    LIconStream.SaveToFile(ChangeFileExt(LImgFilePath,'.cur'));
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
    FreeAndNil(LIconStream);
  end;
end;

//-----------------------------------------------------------------------------
//  アルファチャンネル付き画像のマスク画像を作成する関数
//  元のTBitmapの透過ピクセルを透明色にする必要がある
//
//  透過ピクセルはアルファ値が0のピクセル
//  透明色はARGBの値が全て0のピクセル
//-----------------------------------------------------------------------------
procedure TForm1.CreateAlphaMaskBitmap(MaskTBitmap, OriginTBitmap: TBitmap; X,
  Y: Integer);
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LImgWidth    : Integer;
  LImgHeight   : Integer;
  LXPos        : integer;
  LYPos        : Integer;
  LOrigiinScan : PRGBQArray;
  LMaskScan    : PRGBQArray;
  LAValue      : Byte;
  LRValue      : Byte;
  LGValue      : Byte;
  LBValue      : Byte;
  LMaskAValue  : Byte;
  LMaskRValue  : Byte;
  LMaskGValue  : Byte;
  LMaskBValue  : Byte;
  LPosGet      : Boolean;
begin
  LImgWidth  := MaskTBitmap.Width;
  LImgHeight := MaskTBitmap.Height;

  MaskTBitmap.Canvas.Lock;

  LAValue := 0;
  LRValue := 0;
  LGValue := 0;
  LBValue := 0;

  LPosGet := False;
  for LYPos := 0 to LImgHeight - 1 do begin
    LMaskScan := MaskTBitmap.ScanLine[LYPos];

    //引数の座標値(X, Y)のピクセルの色を取得
    for LXPos := 0 to LImgWidth - 1 do begin
      if (X = LXPos) and (Y = LYPos) then begin
        LAValue := LMaskScan[LXPos].rgbReserved;
        LRValue := LMaskScan[LXPos].rgbRed;
        LGValue := LMaskScan[LXPos].rgbGreen;
        LBValue := LMaskScan[LXPos].rgbBlue;

        LPosGet := True;
        Break;
      end;
    end;
    if LPosGet then Break;
  end;

 if LPosGet then begin
    for LYPos := 0 to LImgHeight - 1 do begin
      LMaskScan := MaskTBitmap.ScanLine[LYPos];
      LOrigiinScan := OriginTBitmap.ScanLine[LYPos];

      for LXPos := 0 to LImgWidth - 1 do begin

        LMaskAValue := LMaskScan[LXPos].rgbReserved;
        LMaskRValue := LMaskScan[LXPos].rgbRed;
        LMaskGValue := LMaskScan[LXPos].rgbGreen;
        LMaskBValue := LMaskScan[LXPos].rgbBlue;

        //ピクセルの色が取得した色と同じ場合は白にする
        //それ以外は透明色にする
        if (LMaskAValue = LAValue) and (LMaskRValue = LRValue)
          and (LMaskGValue = LGValue) and (LMaskBValue = LBValue) then begin

          LMaskScan[LXPos].rgbReserved := $FF;
          LMaskScan[LXPos].rgbRed      := $FF;
          LMaskScan[LXPos].rgbGreen    := $FF;
          LMaskScan[LXPos].rgbBlue     := $FF;

         //PNG画像では複数の透明色を持つ場合がある
         //透明な色(アルファ値が0)の色は透明色にしおく
          LOrigiinScan[LXPos].rgbReserved := 0;
          LOrigiinScan[LXPos].rgbRed      := 0;
          LOrigiinScan[LXPos].rgbGreen    := 0;
          LOrigiinScan[LXPos].rgbBlue     := 0;
        end else begin
          LMaskScan[LXPos].rgbReserved := 0;
          LMaskScan[LXPos].rgbRed      := 0;
          LMaskScan[LXPos].rgbGreen    := 0;
          LMaskScan[LXPos].rgbBlue     := 0;
        end;
      end;
    end;
  end;

  MaskTBitmap.Canvas.Unlock;
end;

end.



04_マルチアイコン操作用 KIcon でマウスカーソルファイルを作成


TKIcon はマルチアイコン操作用のクラスです．マウスカーソルの作成もできます．
実際に作成するアイコンは 1 つだけですから，最初のアイコン，つまりインデックスが 0 のアイコンに対してホットスポットを設定して保存します．




図5
作成したマウスカーソルの画像
  • これは添付の PNG 画像から作成した
  • 赤い四角形がホットスポットの座標
  • 設定通りの位置 (2, 3) になっている

リスト5
マルチアイコン操作用の TKIcon クラスを使用したマウスカーソル画像ファイルの作成		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs, KIcon, KGraphics;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FInitDir     : string;
    FImgFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  PngImage,
  ShellAPI,
  Types;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FInitDir := ExpandFileName('..\TestImages');
  //TPictureでTKIconを扱えるようにする
  RegisterKIcon;
end;

//=============================================================================
//  ビットマップ画像またはPNG形式画像からマウスカーソル画像ファイルを作成
//  マルチアイコン操作用のTKIconの機能を使用する方法
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSaveFilePath : string;
  LPicture      : TPicture;
  LBitmap       : TBitmap;
  LKIcon        : TKIcon;
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.png;*.bmp';
  OpenPictureDialog1.InitialDir := FInitDir;
  if not OpenPictureDialog1.Execute then exit;

  FInitDir :=  ExtractFileDir(OpenPictureDialog1.FileName);


  LPicture := TPicture.Create;
  LBitmap  := TBitmap.Create;
  LKIcon   := TKIcon.Create;
  try
    FImgFilePath   := OpenPictureDialog1.FileName;
    LSaveFilePath  := ChangeFileExt(FImgFilePath, '.ico');
    Label1.Caption := ExtractFileName(FImgFilePath);

    LPicture.LoadFromFile(FImgFilePath);

    //アイコンリストをクリア
    LKIcon.Clear;

    if LPicture.Graphic is TBitmap then begin
      LBitmap.Assign(TBitmap(LPicture.Graphic));
      LKIcon.Add(MakeHandles(LBitmap.Handle, LBitmap.MaskHandle));
    end else
    if LPicture.Graphic is TPngImage then begin
      //PNG画像をTBitmapに変換
      LBitmap.SetSize(LPicture.Width, LPicture.Height);
      LBitmap.Canvas.Draw(0, 0, LPicture.Graphic);
      LKIcon.Add(MakeHandles(LBitmap.Handle, LBitmap.MaskHandle));
    end else begin
      exit;
    end;

    //マウスカーソルの設定をして保存
    LKIcon.Cursor := True;
    LKIcon.HotSpot[0] := Point(2, 3);
    LKIcon.SaveToFile(ChangeFileExt(LSaveFilePath,'.cur'));
  finally
    FreeAndNil(LPicture);
    FreeAndNil(LBitmap);
    FreeAndNil(LKIcon);
  end;
end;

end.



05_作成したマウスカーソルの使用方法


拡張子が .cur のマウスカーソルファイルを読み込んで使用する方法です．
マウスカーソルのファイル名を引数に指定して，LoadCursorFromFile 関数で読み込みます．この関数の戻り値は画像オブジェクトではなく，マウスカーソルのハンドルです．型は HCURSOR です．

ハンドルの値は TScreen.Cursors プロパティに代入しますが，あらかじめ使用するマウスカーソルに定数名を割り当てておきます．後は通常のマウスカーソルと使い方は同じです．設定したマウスカーソルの定数名を使用します．
本サンプルでは，Panel1 のマウスカーソルを変更します．



マウスカーソルの変数名の値は，既に定義されている値と重複しないようにします．この値は TCursor で定義されていますが，システムカーソル用として 0 と -1 から -22 が使用されています．これ以外の値にします．

システムのマウスカーソルは，[パフォーマンスオプション] のダイアログで影を表示することができますが，ユーザが独自に作成したカーソルは影を表示できません．影を表示したい場合は，あらかじめ影付きのマウスカーソルを作成します．
システムのマウスカーソルと置き換えれば影を表示したり，非表示にすることが可能です．ただし，マウスカーソルの変更を自アプリだけに適用するのか，システム全体にするのか考える必要があるかも知れません．




図6
マウスカーソルが Panel1 以外にある時


図7
マウスカーソルが Panel1 内にある時

図8
Button2 クリックで別のマウスカーソルに変更

リスト6
マウスカーソルファイルを読み込んで使用する例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//マウカーソルの定数名を設定しておく
//マウスカーソルのファイル名と同じにしておくといいかも知れない
const
  crMyCursor_1 = 5;
  crMyCursor_2 = 6;

//=============================================================================
//  フォーム生成時の処理
//
//  マウスカーソルをファイルから読み込んでTScreen.Cursorsにセットする
//  ここでセットするのはカーソルのハンドルの値
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.Cursors[crMyCursor_1] := LoadCursorFromFile('livejournal.cur');
  Screen.Cursors[crMyCursor_2] := LoadCursorFromFile('paintcan.cur');
end;

//=============================================================================
//  マウスカーソルを変更してみる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Cursor := crMyCursor_1;
end;

//=============================================================================
//  マウスカーソルを変更してみる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Panel1.Cursor := crMyCursor_2;
end;

end.



06_マウスカーソルを画像として読み込む


マウスカーソルを画像として読み込むには LoadImage 関数が利用できます．
既に述べたように，TIcon はマウスカーソルを拒絶あるいは認識しようとはしませんが，LoadImage 関数でアイコンのハンドルを取得してセットすればほとんとのマウスカーソルを認識してくれます．
もちろん，上のサンプルでテストしたように，TIcon は画像ファイルをアイコン画像として扱っていることになります．





図9
マウスカーソルを画像として TImage に描画

図10
TIcon.LoadFromFile で読み込んだ場合
  • 「アイコンイメージが不正です」となる
  • 実際はアイコンヘッダのファイルタイプの違いだけ．ファイルタイプの値が 1 でないと読み込んでくれない

リスト7
LoadImage(関数を使用してマウスカーソルのファイルを画像として読み込む
TIcon の直接読み込みは例外が発生するが，ハンドルの値を代入すれば画像の取得が可能		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  マウスカーソルの画像をTImageに描画
//
//  TIconには直接セットできない
//  LoadImage関数を使用する
//  引数のサイズを0にして実行すると元のサイズのカーソル画像が取得できる
//  フラグにLR_DEFAULTSIZEを含めるとシステムの既定のサイズで取得する
//  システム既定のサイズは，Windows 7 では32 x 32
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgPath   : string;
  LhICon     : HICON;
  LIcon      : TIcon;
  LIconSizeX : Integer;
  LIconSizeY : Integer;
begin
  LImgPath := ExpandFileName('.\livejournal.cur');

  Label1.Caption := '';
  Image1.Picture.Assign(nil);
  LIcon := TIcon.Create;
  try
    LIconSizeX := 0;
    LIconSizeY := 0;
    LhIcon := LoadImage(0,
                        PChar(LImgPath),
                        IMAGE_CURSOR,
                        LIconSizeX,
                        LIconSizeY,
                        LR_LOADFROMFILE);
    LIcon.Handle := LhIcon;
    Image1.Canvas.Draw(0, 0, LIcon);

    Label1.Caption := IntToStr(LIcon.Width) + ' x ' + IntToStr(LIcon.Height);
  finally
    FreeAndNil(LIcon);
  end;
end;

//=============================================================================
//  TIconはカーソルファイルを直接読み込めないことを確認するコード
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LImgPath : string;
  LIcon    : TIcon;
begin
  LImgPath := ExpandFileName('.\livejournal.cur');

  Label1.Caption := '';
  Image1.Picture.Assign(nil);
  LIcon := TIcon.Create;
  try
    LIcon.LoadFromFile(LImgPath);
    Image1.Canvas.Draw(0, 0, LIcon);
  finally
    FreeAndNil(LIcon);
  end;
end;

end.


前項で使用した LoadCursorFromFile 関数もマウスカーソルのハンドル，つまりアイコンのハンドルを返します．したがって以下ように画像ファイルを読み込みことができます．

リスト8
LoadCursorFromFile 関数を使用してマウスカーソル画像を読み込む		 
procedure TForm1.Button1Click(Sender: TObject);
var
  LImgPath : string;
  LhICon   : HICON;
  LIcon    : TIcon;
begin
  LImgPath := ExpandFileName('.\livejournal.cur');

  Label1.Caption := '';
  Image1.Picture.Assign(nil);
  LIcon := TIcon.Create;
  try
    LhIcon := LoadCursorFromFile(PChar(LImgPath));
    LIcon.Handle := LhIcon;
    Image1.Canvas.Draw(0, 0, LIcon);

    Label1.Caption := IntToStr(LIcon.Width) + ' x ' + IntToStr(LIcon.Height);
  finally
    FreeAndNil(LIcon);
  end;
end;


EXE に組み込んだリソースから読み出す時は LoadCursor 関数を使用します．


リスト9
リソースからマウスカーソルを読み込んで TImage に描画するコード		 
procedure TForm1.Button1Click(Sender: TObject);
var
  LIcon : TIcon;
begin
  LIcon := TIcon.Create;
  try
    LIcon.Handle := LoadCursor(HInstance, 'Cursor_1');
    Image1.Canvas.Draw(0, 0, LIcon);

    LIcon.Handle := LoadCursor(HInstance, 'Cursor_2');
    Image2.Canvas.Draw(0, 0, LIcon);
  finally
    FreeAndNil(LIcon);
  end;
end;



07_マウスカーソルを非表示にする方法


自アプリのマウスカーソルを非表示にするには，カーソルプロパティの値を crNone にします．
マウスカーソルが表示されていなくても，マウスそのものは機能します．



リスト10
マウスカーソルを非表示にするにはカーソルの指定を crNone にする		 
//=============================================================================
//  マウスカーソルの表示・非表示の切り換え
//  アプリケーション内だけで有効
//  非表示にしても，フォームの非クライアント領域では表示する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Screen.Cursor = crNone then begin
    Screen.Cursor := crDefault;
  end else begin
    Screen.Cursor := crNone;
  end;
end;



08_マウスカーソルのスクリーン上の座標を取得


マウスカーソルの現在の位置をスクリーンの座標の値で取得するには，GetCursorPos 関数が利用できます．本サンプルでは，マウスカーソルの位置をスクリーン座標で取得し，TControl.ScreenToClient メソッドで，クリックしたコントロール内の座標に換算して TEdit にその値を表示します．
逆に，コントロール内の座標の値をスクリーン座標値に換算するには TControl.ClientToScreen メソッドを使用します．

マウスカーソルを強制的に指定の位置に移動するには SetCursorPos 関数を使用します．SetCursorPos 関数の引数には，スクリーン座標値を指定します．




図11
マウスカーソルのスクリーン上の位置を知る
  • 取得した値をコントロール内の座標値に換算して表示している

リスト11
マウスカーソルのスクリーン上の座標を取得するには GetCursorPos 関数を使用する		 
//=============================================================================
//  TControlのOnMouseDownイベント処理
//  このサンプルではフォーム上の全てのコントロールで共有している
//
//  フォームの非クライアント領域のクリックは検出できない
//=============================================================================
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LScreenCurPos  : TPoint;
  LControlCurPos : TPoint;
  LControlName   : string;
  LText          : string;
begin
  //スクリーン上のマウスカーソル位置を取得
  GetCursorPos(LScreenCurPos);

  //コントロール上の座標値に変換して表示
  LControlCurPos := TControl(Sender).ScreenToClient(LScreenCurPos);

  //どのコントロールの上にあるかをスクリーン座標から取得
  //本サンプルではTControl(Sender).Name;でよい
  LControlName := FindDragTarget(LScreenCurPos, True).Name;

  LText := ' X:' + IntToStr(LControlCurPos.X)
         + ' Y:' + IntToStr(LControlCurPos.Y)
         + '   ' + LControlName;
  Edit1.Text := LText;
end;



09_[ Ctrl ] キーでマウスポインタの位置を確認する方法


マウスカーソルのソナー機能を使用すると，[Ctrl] キー押下で，モニタ上のマウスカーソルがどこにあるか確認しやすくなります．
以下は SystemParametersInfo の SPI_SETMOUSESONAR でソナー機能を設定する例です．




図12
マウスカーソルのソナー機能の設定

図13
[Ctrl] キーを押して放すとアニメーションで円が表示される

リスト12
マウスカーソルのソナー機能の設定		 
//=============================================================================
//  ソナー機能を有効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETMOUSESONAR ,
                       0,
                       Pointer(True),
                       SPIF_UPDATEINIFILE);
end;

//=============================================================================
//  ソナー機能を無効にする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETMOUSESONAR ,
                       0,
                       Pointer(False),
                       SPIF_UPDATEINIFILE);
end;


ソナー機能はシステム関係のダイアログからも設定できます．
以下のコマンドを [ファイル名を指定して実行] のダイアログで実行して，[マウスのプロパティ] ダイアログの [ポインターオプション] タブを表示します．[Ctrl キーを押すとポインターの位置を表示する] をチェックします．

%SystemRoot%\System32\control.exe /name Microsoft.Mouse /page 2



図14
[Ctrl キーを押すとポインターの位置を表示する] をチェックする

[備考]
上のマウスカーソル位置のアニメーションのキャプチャ画像は，当サイトで提供しているスクリーンキャプチャのサンプルだけではキャプチャできませでした．
Windows 7 の拡大鏡を起動し，倍率を 100 % の固定にしました．その状態で拡大鏡のウィンドウ内を矩形領域キャプチャしました．拡大鏡のウィンドウに表示されているのは，その部分のキャプチャ画像です．そのことを利用しています．




10_GUI 操作でマウスカーソルのホットスポットを設定するプログラム


マウスカーソルのホットスポットはコードでも設定できますが，画像で確認して設定できる方が便利です．アイコン画像の作成編集用のソフトの多くはホットスポットの設定機能を実装しています．
また，当サイトの以下のプログラムには，マウスカーソルのホットスポットを GUI 操作で設定できる機能を実装しています．



現在は多くのアイコンがネットで入手可能です．マウスカーソルの画像とて使用可能なアイコンもあります．それらの多くは Windows Vista 以降に対応したアルファチャンネル付きの PNG 形式の画像です．画像の加工等が必要なければ，上のリンクのようなプログラムで変換して利用できます．



[備考]
RealWorld Cursor Editor は，参考リンクの記事からはマウスカーソル作成専用のような印象を受けますが，実際には GIF, BMP, PNG 形式での保存もできます．





11_Windows におけるマウスカーソルのサイズ


Windows では通常，マウスカーソルとして 32 x 32 サイズの画像が使われます．
コントロールパネルの [マウスのプロパティ] の [ポインタ] タブで [特大のフォント] を設定した場合は，32 x 32 のサイズの画像の中で一番大きく描かれたカーソル画像のファイルが使われます．
本ページで説明している方法で 32 x 32 以外のサイズのカーソル画像を作成しても，32 x 32 の大きさに拡大または縮小して表示されます．

下図は [Win] + [U] のダイアログで [マウスを使いやすくします] をクリックした時に表示されるカーソルの画像です．3 つのサイズがありますが，画像のサイズとしては全て 32 x 32 です． これらの 3 つの画像はそれぞれ別のカーソルファイルとなっています．



図15
マウスポインタの設定画面
  • [コントロールパネル] の
    [マウス] の [ポインタ] タブでも設定できる
図16
カーソルの拡大画像
  • 左は標準のフォントにした時の画像
  • 右は特大のフォントの場合
  • 画像としてのサイズはどちらも同じ 32 x 32
  • 矢印の内部のピクセルの色は主に白
  • 矢印周辺を除いた外側のピクセルは透明

[Windows] [Cursors] フォルダ内のカーソルファイルには 32 x 32 と 48 x 48 のサイズの画像が格納されたマルチカーソルファイルがあります．
下図のディスプレイの設定で，[小 - 100%] または [中 - 125%] に設定した時は 32 x32 のサイズのカーソル画像が使われ，[大 - 150%] にした時に 48 x 48 サイズのカーソル画像が使用されるようになっています．Windows 8.1 には [特大 - 200%]，[超特大 - 250%] があります．この特大の時は 64 x 64 サイズのマウスカーソル画像が使用されることになっていますが，該当するサイズの画像がない場合，既存のサイズの画像が拡大表示されるようになっています．

マウスカーソルの画像サイズは，ディスプレイの設定が [小 - 100%] または [中 - 125%] である限り常に 32 x 32 のサイズになります．


図17
ディスプレイの設定

下図のように，32 x 32, 48 x 48, 64 x 64 のサイズのカーソル画像を作成して，Arrow_Multi.cur という名前で 1 つのファイルに保存しました．このカーソルファイルを使用して，ディスプレイの設定で実際の動作を確認してみました．どの画像が使われたかを確認しやすいように，サイズごとに色を変えています．



図18
用意したマウスカーソルの画像
  • サイズごとに色を変えている

下図が実際の実行結果です．筆者の Windows 7 には 200 % の設定がないので Windows 10 でテストしています．上の図も下図も実寸で掲載しています．200 % の時の結果が 250 % のように感じるのは筆者の気のせいかも知れません．



図19
100 % の時
図20
150 % の時
図21
200 % の時
  • 250 % のような気がする

[備考]
マウスカーソルのポインタ位置に大きな画像を表示して，カーソルの位置を確認しやすくするプログラムが以下のリンクから入手できます．
WheelPLUS はシステム本来のカーソルを非表示 (透明) にして別の画像を表示します．次の 2 つはシステム本来のカーソルの下に別の大きな画像を表示します．最後のはマウスカーソルというより，プレゼンテーション用のポインタです．



リスト13
テストに使用したコード		 
implementation

{$R *.dfm}

const
  crMyCursor_1 = 5;

//=============================================================================
//  フォーム生成時の処理
//  マウスカーソルをファイルから読み込んでTScreen.Cursorsにセットする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.Cursors[crMyCursor_1] := LoadCursorFromFile('Arrow_Multi.cur');
  Button1.Cursor := crMyCursor_1;
end;



12_システムのマウスカーソルを自作のカーソル画像に変更


ここまでのテストでは自アプリのマウスカーソルの変更でした．システム全体でカーソル画像を変更して使用するには SetSystemCursor 関数を使用します．
以下のリンクにもシステムのカーソルを変更するサンプルがありますが，システムで用意されているカーソルに変更するサンプルとなっています．

本サンプルでは自作のカーソル画像に変更します．カーソル画像として，前項で使用したマルチカーソルファイルを使用しますが，32 x 32 サイズの画像を削除してテストしてみました．そうすると 48 x 48 のサイズの画像を縮小表示することになりまます．  



[備考]
ここまでのサンプルのように，自アプリで使用するカーソルには Drop Shadow と呼ばれる半透明の影 (アルファシャドウ) が描画されませんが，SetSystemCursor 関数で設定したカーソルにはアルファシャドウが描画されます．



図22
EXE を実行して [Button1] をクリックした結果
  • 32 x 32 サイズの画像がないので 48 x 48 の画像が縮小されて表示されている
図23
カーソル画像の拡大図
  • あまり綺麗とは言えない

リスト14
システムのマウスカーソルを自作のカーソル画像に変更		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FCurFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FCurFilePath := 'Arrow_Multi.cur';
end;

//=============================================================================
//  フォーム破棄時の処理
//  システム既定のカーソルの設定に戻しておく
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETCURSORS, 0, nil, 0);
end;

//=============================================================================
//  システムのカーソルを変更する
//  ここではOCR_NORMAL(矢印)を変更する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetSystemCursor(LoadCursorFromFile(PChar(FCurFilePath)), OCR_NORMAL);
end;

//=============================================================================
//  システム既定のカーソルに戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FormDestroy(nil);
end;

end.



13_システムのマウスカーソルを自作のカーソル画像に恒久的に変更


SetSystemCursor 関数で設定したカーソルは，コンピュータを再起動すると既定のカーソルに戻ります．システムのカーソル画像を恒久的に変更するには，[コントロールパネル] [マウス] のダイアログで設定します．
レジストリを直接変更する場合は，下図のキーのデータ値を，使用するカーソルファイル名に変更して，システム既定のカーソルにするコードを実行します．システム既定のカーソルというのは，このレジストリで設定されているカーソルのことを意味します．
データの種類の REG_EXPAND_SZ は環境変数を含むユニコード文字列の意味です．



図24

以下のコードは実際にレジストリの値を書き換えてカーソル画像を変更する例です．このサンプルでは矢印 (Arrow) のカーソル画像だけを変更します．
テストなので，カーソル画像は，プログラムを終了すると元に戻すようにしています．



図25
実行結果
  • カーソルは添付の 32 x 32 の画像

リスト15
システムのマウスカーソルを自作のカーソル画像に恒久的に変更		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FOriginCurPath : string;
    FNewCurPath    : string;
    function GetSysCurFile(AKind: string): string;
    function ChangeSysCurFile(AKind: string; APath: string): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Registry;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  現在のシステムのArrowカーソルのパスを取得して退避
//
//  usesにRegistryが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FOriginCurPath := GetSysCurFile('Arrow');
  if FOriginCurPath <> '' then begin
    FNewCurPath := ExpandFileName('.\NewArrow.cur');
  end;
end;

//=============================================================================
//  フォーム破棄時の処理
//  システム既定のカーソルを元に戻しておく
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeSysCurFile('Arrow', FOriginCurPath);
end;

//=============================================================================
//  システムのカーソルを変更する
//  Arrowを変更する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeSysCurFile('Arrow', FNewCurPath);
end;

//=============================================================================
//  システム既定のカーソルを元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FormDestroy(nil);
end;

//-----------------------------------------------------------------------------
//  システムのマウスカーソルファイルのパス名を取得する
//-----------------------------------------------------------------------------
function TForm1.GetSysCurFile(AKind: string): string;
var
 LRegistry  : TRegistry;
 LRegistKey : string;
begin
  Result := '';

  LRegistry := TRegistry.Create(KEY_READ);
  try
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LRegistKey := 'Control Panel\Cursors';
    if LRegistry.OpenKey(LRegistKey, True) then begin
      Result := LRegistry.ReadString(AKind);
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;

//-----------------------------------------------------------------------------
//  システムのマウスカーソルを変更する
//-----------------------------------------------------------------------------
function TForm1.ChangeSysCurFile(AKind, APath: string): Boolean;
var
 LRegistry  : TRegistry;
 LRegistKey : string;
begin
  Result := False;
  if APath = '' then exit;

  LRegistry := TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LRegistKey := 'Control Panel\Cursors';
    if LRegistry.OpenKey(LRegistKey, True) then begin
      LRegistry.WriteString(AKind, APath);
      SystemParametersInfo(SPI_SETCURSORS, 0, nil, 0);
      Result := True;
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;

end.