VB.NET のカレンダーコントロールのカスタマイズ

Question

実現したいこと

・VB.NETのフォームアプリで以下の要件のカレンダーを表示する
１．日付セルの数字下に文字を表示させる（予定あり、等）
２．表示させた日付の色を変える
３．該当の条件に合う日の数字を〇で囲む

・想定コントロールは以下の通り
１．MonthCalendar (.netの標準コントロール)
２．GcCalendar（Grapecityのコントロール）

前提

ここに質問の内容を詳しく書いてください。
（例）
使用環境はVisualStudio2008
GrapecityのバージョンはGrapeCity.Win.PlusPak.v60(6.0.2010.518)

発生している問題・エラーメッセージ

セルを指定するメンバが見つからず、アイデアが見つからない状況です。

試したこと

Private Sub MonthCalendar1_DateSelected(ByVal sender As Object, ByVal e As DateRangeEventArgs) Handles MonthCalendar1.DateSelected
    Dim cellIndex As Integer = MonthCalendar1.HitTest(e.Start).Day - 1
    Dim cellRect As Rectangle = MonthCalendar1.Bounds
    cellRect.X += cellIndex * cellRect.Width / 7
    cellRect.Y += cellRect.Height
    cellRect.Height = 20
    Dim g As Graphics = MonthCalendar1.CreateGraphics()
    g.DrawString("Hello", Me.Font, Brushes.Black, cellRect)
End Sub

上記のようなソースを記載して、文字の表示を試みました。

補足情報（FW/ツールのバージョンなど）

使用環境はVisualStudio2008
GrapecityのバージョンはGrapeCity.Win.PlusPak.v60(6.0.2010.518)

Answer 1

MonthCalendar コントロールのセル情報を取得するには、MCM_GETCALENDARGRIDINFO メッセージを送ります。
https://learn.microsoft.com/ja-jp/windows/win32/controls/mcm-getcalendargridinfo

Imports System.Runtime.InteropServices

Public Class Form1

    Private Const MCM_FIRST As Integer = &H1000
    Private Const MCM_GETCALENDARGRIDINFO As Integer = MCM_FIRST + 24

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
    Private Class MCGRIDINFO
        Implements IDisposable
        Public cbSize As Integer
        Public dwPart As Integer
        Public dwFlags As UInteger
        Public iCalendar As Integer
        Public iRow As Integer
        Public iCol As Integer
        Public bSelected As Integer
        Public stStart As SYSTEMTIME
        Public stEnd As SYSTEMTIME
        Public rc As RECT
        Private pszNamePtr As IntPtr
        Private cchNamePtr As IntPtr

        Public Sub New(part As Integer, flags As Integer)
            cbSize = Marshal.SizeOf(Me)
            dwPart = part
            dwFlags = flags
            cchName = 1024
            pszNamePtr = Marshal.StringToCoTaskMemUni(New String(ChrW(0), cchName * 2))
        End Sub

        Public Sub Dispose() Implements IDisposable.Dispose
            Marshal.FreeCoTaskMem(pszNamePtr)
        End Sub

        Public ReadOnly Property pszName As String
            Get
                Return Marshal.PtrToStringUni(pszNamePtr)
            End Get
        End Property

        Public Property cchName As Integer
            Get
                Return cchNamePtr.ToInt32()
            End Get
            Set(value As Integer)
                cchNamePtr = New IntPtr(value)
            End Set
        End Property

    End Class

    Private Const MCGIP_CALENDARCONTROL = 0
    Private Const MCGIP_NEXT = 1
    Private Const MCGIP_PREV = 2
    Private Const MCGIP_FOOTER = 3
    Private Const MCGIP_CALENDAR = 4
    Private Const MCGIP_CALENDARHEADER = 5
    Private Const MCGIP_CALENDARBODY = 6
    Private Const MCGIP_CALENDARROW = 7
    Private Const MCGIP_CALENDARCELL = 8

    Private Const MCGIF_DATE = &H1
    Private Const MCGIF_RECT = &H2
    Private Const MCGIF_NAME = &H4

    <StructLayout(LayoutKind.Sequential)>
    Public Structure SYSTEMTIME
        Public wYear As Short
        Public wMonth As Short
        Public wDayOfWeek As Short
        Public wDay As Short
        Public wHour As Short
        Public wMinute As Short
        Public wSecond As Short
        Public wMilliseconds As Short
        Public Function ToDateTime() As DateTime
            Return New DateTime(wYear, wMonth, wDay, wHour,
                                wMinute, wSecond, wMilliseconds)
        End Function
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
        Public Function ToRectangle() As Rectangle
            Return Rectangle.FromLTRB(Left, Top, Right, Bottom)
        End Function
    End Structure

    <DllImport("user32.dll", CharSet:=CharSet.Unicode)>
    Private Shared Function SendMessage(hWnd As IntPtr, Msg As Integer,
                                        wParam As IntPtr, lParam As MCGRIDINFO) As IntPtr

    End Function

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        ShowGridInfo(0, 0)
        ShowGridInfo(0, 1)
        ShowGridInfo(0, 2)
        ShowGridInfo(1, 0)
        ShowGridInfo(1, 1)
        ShowGridInfo(1, 2)
    End Sub

    Private Sub ShowGridInfo(Row As Integer, Column As Integer)
        Using info As New MCGRIDINFO(MCGIP_CALENDARCELL, MCGIF_DATE Or MCGIF_RECT Or MCGIF_NAME)
            info.iRow = Row
            info.iCol = Column
            Dim ret = SendMessage(MonthCalendar1.Handle, MCM_GETCALENDARGRIDINFO, IntPtr.Zero, info)
            Debug.Print($"({Row},{Column})は{info.rc.ToRectangle()}の位置にあります。")
            Debug.Print($"日付は{info.stStart.ToDateTime():yyyy/MM/dd}で、{info.pszName}が表示されています。")
        End Using
    End Sub

End Class

カスタム描画ですが、CreateGraphics で作成した Grapchis オブジェクトに描画すると、ウインドウを最小化して戻す等、なにかの拍子に消えてしまいます。
コントロールを継承し、以下のように描画してください。

Public Class MonthCalendarEx
    Inherits MonthCalendar

    Private Const WM_PAINT = &HF

    Protected Overrides Sub OnHandleCreated(e As EventArgs)
        MyBase.OnHandleCreated(e)
        OwnerDraw = True
    End Sub

    Protected Overrides Sub OnHandleDestroyed(e As EventArgs)
        MyBase.OnHandleDestroyed(e)
        OwnerDraw = False
    End Sub

    Protected WriteOnly Property OwnerDraw As Boolean
        Set(value As Boolean)
            SetStyle(ControlStyles.UserPaint Or
                     ControlStyles.AllPaintingInWmPaint Or
                     ControlStyles.OptimizedDoubleBuffer, value)
        End Set
    End Property

    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        'e.Graphics にネイティブ画像を描画してもらう
        Dim hdc = e.Graphics.GetHdc()
        Dim m = Message.Create(Handle, WM_PAINT, hdc, IntPtr.Zero)
        DefWndProc(m)
        e.Graphics.ReleaseHdc()

        ' ここで e.Graphics に対しカスタム描画を行う

        MyBase.OnPaint(e)
    End Sub

End Class

Comments

[KOZ6.0]

というか、GcCalendar を使えば要件を満たせるのでは？
https://docs.grapecity.com/help/pluspak-winforms-8/GcCalendar_Index.html