Print Page | Close Window

How To Show Week Numbers in DateTimePicker

Printed From: Codejock Forums
Category: General
Forum Name: Visual Basic Code Snippets
Forum Description: Visual Basic Code Snippets
URL: http://forum.codejock.com/forum_posts.asp?TID=17826
Printed Date: 25 April 2024 at 9:49am
Software Version: Web Wiz Forums 12.04 - http://www.webwizforums.com


Topic: How To Show Week Numbers in DateTimePicker
Posted By: Xander75
Subject: How To Show Week Numbers in DateTimePicker
Date Posted: 02 February 2011 at 8:38am
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



-------------
Product: Xtreme SuitePro (ActiveX) v15.3.1
Platform: Windows 7 64-bit (SP1) Professional Edition
Languages: C#.Net using Visual Studio 2012 & Visual Basic 6.0 (SP6)



Print Page | Close Window

Forum Software by Web Wiz Forums® version 12.04 - http://www.webwizforums.com
Copyright ©2001-2021 Web Wiz Ltd. - https://www.webwiz.net