How To Show Week Numbers in DateTimePicker

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

   Hi,

I know some people have asked for Codejock to implement this in their DateTimePicker control so I thought I would add the code here on how to show week numbers until they implement it as an option. This also works with the Microsoft DatePicker control.

Add the code snippet below to a module:

Option Explicit

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_STYLE = (-16)

' MonthCalendar specific constants. Requires comctl32.dll ver. 4.70
Public Const MCM_FIRST = &H1000
Public Const MCM_GETMINREQRECT = (MCM_FIRST + 9)
Public Const MCS_WEEKNUMBERS = &H4

' DateTime Picker specific constants. Requires comctl32.dll ver. 4.70
Public Const DTM_FIRST = &H1000
Public Const DTM_GETMONTHCAL = (DTM_FIRST + 8)

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Then add the following into the DropDown event of the DateTimePicker control:

Private Sub DateTimePicker_DropDown()
   Dim objStyle As Long
   Dim objRect As RECT
   Dim hCal As Long

   ' Get the handle to the DropDown Calendar
   hCal = SendMessage(DateTimePicker.hwnd, DTM_GETMONTHCAL, 0, 0)
   ' If hCal is greater than zero then the MonthCalendar exists
   If hCal > 0 Then
      ' Get the current style of the DropDown Calendar:
      objStyle = GetWindowLong(hCal, GWL_STYLE)
      ' ..and add the WeekNumber style..
      objStyle = objStyle Or MCS_WEEKNUMBERS
      ' Set the new style in the DropDown Calendar
      Call SetWindowLong(hCal, GWL_STYLE, objStyle)
      ' Get the minimum size of the DropDown calendar that will show all
      ' of the calendar.
      SendMessage hCal, MCM_GETMINREQRECT, 0, objRect
      ' ..and size the DropDown calendar to the size required.
      MoveWindow hCal, 0, 0, objRect.Right + 2, objRect.Bottom, True
   End If
End Sub