Month Calendar Double Click

Option Explicit

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

Private Type MCHITTESTINFO
   Size As Long
   Point As POINTAPI
   HitItem As Long
   HitDate As SYSTEMTIME
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Const MCM_FIRST As Long = &H1000
Private Const MCM_HITTEST As Long = (MCM_FIRST + 14)

Private Const MCHT_CalendarDate As Long = &H20001
Private Const MCHT_CalendarToday As Long = &H30000

Private Sub MonthCalendar1_DblClick()
   Dim l_Pt As POINTAPI
   Dim l_Hit As MCHITTESTINFO
   
   GetCursorPos l_Pt
   ScreenToClient Me.MonthCalendar1.hwnd, l_Pt
   
   With l_Hit
      .Size = LenB(l_Hit)
      .Point.x = l_Pt.x
      .Point.y = l_Pt.y
   End With
   SendMessage Me.MonthCalendar1.hwnd, MCM_HITTEST, 0, l_Hit
   
   Select Case l_Hit.HitItem
   Case MCHT_CalendarDate
      MsgBox "Double-clicked a date on the calendar: " & Format$(Me.MonthCalendar1.Value, "Long Date")
   Case MCHT_CalendarToday
      MsgBox "Double-clicked the ""Today"" link", vbOKOnly
   End Select
End Sub