C# と VB.NET の質問掲示板

VB.NETを使って、
動的にカーソルアイコンを生成するプログラムを書いています。


以下のようなコードでうまく動作することを確認できています。



    Dim Cursor_Image As Windows.Forms.Cursor

    Private Sub PictureBox2_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox2.MouseMove


        Using bmp As New Bitmap(1, 1)
		
		ここでカーソルを生成

            If Cursor_Image IsNot Nothing Then

                DestroyIcon(Cursor_Image.Handle)
                Cursor_Image.Dispose()
                Cursor_Image = Nothing

            End If


            Dim hicon As IntPtr = bmp.GetHicon()

            Dim info As New ICONINFO()
            GetIconInfo(hicon, info)
            info.xHotspot = bmp.Width \ 2
            info.yHotspot = bmp.Height \ 2
            info.fIcon = CInt(False)


            DestroyIcon(hicon)
            hicon = Nothing


            Dim hicon2 = CreateIconIndirect(info)


            Cursor_Image = New System.Windows.Forms.Cursor(hicon2)
            PictureBox2.Cursor = Cursor_Image

        End Using

    End Sub


http://raizo.blog21.fc2.com/blog-entry-319.html

このページにあるように、
DestroyIconでアイコンを廃棄せずに
何度も実行するとbmp.GetHicon()でエラーが発生してしまうことが分かっています。

そのため、カーソルを共有変数にした上で毎回廃棄するようにしてみたのですが、
数千回くらい実行すると
bmp.GetHicon()でエラーが発生してしまいます。



上記のコードではカーソルのホットスポットを変更するために
二段階に分けてカーソルのハンドルを生成していますが、
以下のように一段階で生成するようにするとなぜかエラーが出なくなります。


                        Dim hicon As IntPtr = bmp.GetHicon()
                        Cursor_Circle = New System.Windows.Forms.Cursor(hicon)
                        Pbox.Cursor = Cursor_Circle

どのようにすれば、二段階でのカーソル生成で
エラーが出なくなりますか？

■No100781 (クレ さん) に返信
> 		ここでカーソルを生成
> 
>             If Cursor_Image IsNot Nothing Then
> 
>                 DestroyIcon(Cursor_Image.Handle)
>                 Cursor_Image.Dispose()
>                 Cursor_Image = Nothing
> 
>             End If

DestroyIcon の戻り値を確認してください。
おそらく False が返ってきてると思われます。というのは

>             Dim info As New ICONINFO()
>             GetIconInfo(hicon, info)
>             info.xHotspot = bmp.Width \ 2
>             info.yHotspot = bmp.Height \ 2
>             info.fIcon = CInt(False)

ICONINFO.fIcon に False を渡すと、カーソルが作られるからです。
（カーソルの削除は DestroyCursor）

なので、

>             info.fIcon = CInt(False)

この行を消せばよい気がします。
（あるいは、DestroyCursor(Cursor_Image.Handle) とする)

API の宣言が不具合の原因になっている可能性もあるので
コードを投稿するときは、宣言部分も書きましょう。

■No100786 (KOZ) に返信

完成したコードが無いのも残念なので、投下しておきます。
GetIconInfo で取得した ICONINFO 構造体（Class として宣言）を Cursor.Tag プロパティに保持しておき、不要になったら削除します。

Imports System.Runtime.InteropServices

Public Class Form1

    Private Cursor_Image As Cursor

    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
        DestroyCursor(Cursor_Image)
        Using bmp As New Bitmap(16, 16)
            Using g As Graphics = Graphics.FromImage(bmp)
                g.DrawLine(Pens.Red, 0, 0, 0, 5)
                g.DrawLine(Pens.Red, 0, 0, 5, 0)
                g.DrawLine(Pens.Red, 0, 0, 15, 15)
            End Using
            Cursor_Image = CreateCursor(bmp, 0, 0)
            PictureBox1.Cursor = Cursor_Image
        End Using
    End Sub

    Protected Overrides Sub OnFormClosed(e As FormClosedEventArgs)
        MyBase.OnFormClosed(e)
        DestroyCursor(Cursor_Image)
    End Sub

    Private Shared Function CreateCursor(bmp As Bitmap, x As Integer, y As Integer) As Cursor
        Dim hIcon As IntPtr = bmp.GetHicon()
        Dim info As New ICONINFO()
        GetIconInfo(hIcon, info)
        DestroyIcon(hIcon)
        info.xHotspot = x
        info.yHotspot = y
        info.fIcon = 0
        Dim hCursor As IntPtr = CreateIconIndirect(info)
        Dim cursor = New Cursor(hCursor) With {.Tag = info}
        Return cursor
    End Function

    Private Shared Sub DestroyCursor(ByRef cursor As Cursor)
        If cursor IsNot Nothing Then
            DestroyIcon(cursor.Handle)
            Dim info As ICONINFO = TryCast(cursor.Tag, ICONINFO)
            If info IsNot Nothing Then
                DeleteObject(info.hbmColor)
                DeleteObject(info.hbmMask)
            End If
            cursor.Dispose()
            cursor = Nothing
        End If
    End Sub

    <StructLayout(LayoutKind.Sequential)>
    Private Class ICONINFO
        Public fIcon As Integer
        Public xHotspot As Integer
        Public yHotspot As Integer
        Public hbmMask As IntPtr
        Public hbmColor As IntPtr
    End Class

    <DllImport("user32.dll")>
    Private Shared Function GetIconInfo(hIcon As IntPtr, iconinfo As ICONINFO) As Boolean
    End Function

    <DllImport("user32.dll")>
    Private Shared Function CreateIconIndirect(iconInfo As ICONINFO) As IntPtr
    End Function

    <DllImport("user32.dll")>
    Private Shared Function DestroyIcon(hIcon As IntPtr) As Boolean
    End Function

    <DllImport("gdi32.dll")>
    Private Shared Function DeleteObject(hObject As IntPtr) As Boolean
    End Function

End Class