For a drawing application I needed to be able to set the cursor dynamically to reflect the current size and color of the brush. I was working in VB6 (love it!) and with GDI, and the following does what I wanted. It uses a number of Windows API methods which signatures can be found on MSDN. All methods called in the code below are API methods.
First, some constants and the type
IconInfo that is needed for the Windows API:
Private Const GCL_HCURSOR = -12
Private Const BLACKNESS = 66
Private Const WHITENESS = 16711778
Private Const BLACK_BRUSH = 4
Private Const BLACK_PEN = 7
Private Const DC_BRUSH = 18
Private Const DC_PEN = 1
Private Type IconInfo
IsIcon As Boolean
Hotspot As PointL
MaskBitmap As Long
ColorBitmap As Long
End Type
You need to create a color bitmap of your cursor and a mask bitmap for it's transparancy. The following code creates a round cursor of
size pixels and the color
color.RgbColor.
'Create color bitmap
Dim colorDc As Long: colorDc = CreateCompatibleDC(mHdc)
mCursorInfo.ColorBitmap = CreateCompatibleBitmap(mHdc, size, size)
Dim prevColorBmp As Long: prevColorBmp = SelectObject(colorDc, mCursorInfo.ColorBitmap)
PatBlt colorDc, 0, 0, size, size, BLACKNESS
SelectObject colorDc, GetStockObject(DC_BRUSH)
SelectObject colorDc, GetStockObject(DC_PEN)
SetDCBrushColor colorDc, color.RgbColor
SetDCPenColor colorDc, color.RgbColor
Ellipse colorDc, 0, 0, size, size
SelectObject colorDc, prevColorBmp
DeleteDC colorDc
'Create mask bitmap
Dim maskDc As Long: maskDc = CreateCompatibleDC(mHdc)
mCursorInfo.MaskBitmap = CreateCompatibleBitmap(mHdc, size, size)
Dim prevMaskBmp As Long: prevMaskBmp = SelectObject(maskDc, mCursorInfo.MaskBitmap)
Rectangle maskDc, -1, -1, size + 1, size + 1
SelectObject maskDc, GetStockObject(BLACK_BRUSH)
SelectObject maskDc, GetStockObject(BLACK_PEN)
Ellipse maskDc, 0, 0, size, size
SelectObject maskDc, prevMaskBmp
DeleteDC maskDc
Then you need to tell Windows to use these as cursor. If I created a cursor before, I destroy it and it's bitmaps to free the memory:
'Create cursor
mCursorInfo.Hotspot.X = size / 2
mCursorInfo.Hotspot.Y = size / 2
mCursor = CreateIconIndirect(mCursorInfo)
If mCursor <= 0 Then
Debug.Print "Could not create dot."
Else
origCursor = SetCursor(mCursor)
SetClassLong mHwnd, GCL_HCURSOR, mCursor
If prevCursor > 0 Then
If DestroyIcon(prevCursor) = False Then Debug.Print "Could not delete dot."
DeleteObject prevInfo.ColorBitmap
DeleteObject prevInfo.MaskBitmap
End If
End If
