Thank you Borje Hagsten for Calendar Control example

[Robert Floyd]

Thank you Borje Hagsten for Calendar Control examplein the PB Windows Downloads! I was really stuck until I found your example. Hopefully, I'll manage from here.

Best regards,
Bob Floyd

[Don Bonnice]

Initializing

Is there a way to initialize the calendar to a specific date?

[Michael Mattias]

Assuming this is the month calendar control (no link to code you reference provided), the MCM_SETCURSEL message looks promising...

Sets the currently selected date for a month calendar control. If the specified date is not in view, the control updates the display to bring it into view. You can send this message explicitly or by using the MonthCal_SetCurSel macro.

MCM

[Pierre Bellisle]

Hi Don,

try the following...

   'After the "SELECT CASE CBMSG", put the following...
 
      CASE %WM_INITDIALOG
         LOCAL hCalendar    AS DWORD
         LOCAL CalendarDate AS SYSTEMTIME
         
         hCalendar = GetDlgItem(CBHNDL, %ID_CALENDAR) 'Get the calendar handle
         CalendarDate.wYear  = 2000
         CalendarDate.wMonth = 06
         CalendarDate.wDay   = 24
         SendMessage hCalendar, %MCM_SETCURSEL, 0, VARPTR(CalendarDate) 'Set the date

[Pierre Bellisle]

Robert,

We are without new's from Börge since a long time,
he has been ill...

See http://www.powerbasic.com/support/pb...ad.php?t=32741

[Paul Purvis]

I did some internet searching using his name but i did not find anything of new.
Somebody that was active in the computer tech field, it just does not make sense to be absence from the internet with such quickness.

paul

[Don Bonnice]

Thanks! That is exactly what I was looking for.

I am looking for a date validation routine. THis control does a decent job for what I am needing.

[Robert Floyd]

Pierre Bellisle,

Thanks for the code. I have been successful with Borje Hagsten's code. As it turns out, though, I too am interested in being able to set an initial date, so I will pursue adding your code and trying. Thanks so much the code and the update on Borje Hagsten.

Best regards,
Bob

[Bill Scharf]

I am struggling with the best way to set the date. I have tried using

SendMessage hCalendar, %MCM_SETCURSEL, 0, VARPTR(CalendarDate)

However, that does not fire the %MCN_SELCHANGE message. Does anybody know a way to programmatically change the date on the calendar control so that the MCN_SELCHANGE is then fired? Any thoughts or insight would be appreciated.

[Fred Harris]

Just dug this out of my piles of code templates. The program is about as simple an Api (SDK) style as you can get that creates a MonthCal control on a form/dialog and sets the date to today's date and displays it in msgbox. These common controls seem to have lots of fairly easy to use macros that seem to be wrappers on other Api functions that are a bit harder to use.

#Compile Exe
#Dim All
#Include "Win32api.inc"
#Include "Commctrl.inc"
%IDC_CALENDAR=1500

Function WndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) Export As Long
  Local dwStyle,dwExStyle,hCalFont,hCal As Dword
  Local st As SYSTEMTIME
  Local hDC As Long

  Select Case wMsg
    Case %WM_CREATE
      hDC=GetDC(hWnd)
      dwExStyle=%WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR
      dwStyle=%WS_BORDER Or %WS_CHILD Or %WS_VISIBLE Or %MCS_DAYSTATE
      hCal=CreateWindowEx(dwExStyle,"SYSMONTHCAL32","",dwStyle,5,5,306,255,hWnd,%IDC_CALENDAR,GetModuleHandle(ByVal %NULL),ByVal %Null)
      hCalFont=CreateFont(20,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
      Call SendMessage(hCal,%WM_SETFONT,hCalFont,1)
      Call ReleaseDC(hWnd,hDC)
      WndProc=0
      Exit Function
    Case %WM_SIZE
      MonthCal_GetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
      MsgBox("Today Is " & Trim$(Str$(st.wMonth)) & "/" & Trim$(Str$(st.wDay)) & "/" & Trim$(Str$(st.wYear)))
      WndProc=0
      Exit Function
    Case %WM_DESTROY
      Call PostQuitMessage(0)
      WndProc=0
      Exit Function
  End Select

  WndProc=DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function

Function WinMain(ByVal hIns As Long, ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr, ByVal iShow As Long) As Long
  Local uCC As INIT_COMMON_CONTROLSEX
  Local winclass As WndClassEx
  Local szAppName As Asciiz*16
  Local hWnd As Dword
  Local Msg As tagMsg

  szAppName="Calendar"
  uCC.dwSize = SizeOf(uCC)
  uCC.dwICC  = %ICC_DATE_CLASSES
  Call InitCommonControlsEx(uCC)
  winclass.cbSize=SizeOf(winclass)
  winclass.style=%CS_HREDRAW Or %CS_VREDRAW
  winclass.lpfnWndProc=CodePtr(WndProc)
  winclass.cbClsExtra=0
  winclass.cbWndExtra=0
  winclass.hInstance=hIns
  winclass.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  winclass.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
  winclass.hbrBackground=%COLOR_BTNFACE+1
  winclass.lpszMenuName=%NULL
  winclass.lpszClassName=VarPtr(szAppName)
  RegisterClassEx winclass
  hWnd=CreateWindowEx(0,szAppName,"Calendar",%WS_OVERLAPPEDWINDOW,200,100,325,300,0,0,hIns,ByVal 0)
  ShowWindow hWnd,iShow
  UpdateWindow hWnd
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend

  Function=msg.wParam
End Function

[Fred Harris]

Modified To Demo MonthCal_SetCurSel()

I added a button to the bottom of the dialog from the above example that when you click it it sets the date to my birthday, which is way, way, back in the last century!

#Compile Exe
#Dim All
#Include "Win32api.inc"
#Include "Commctrl.inc"
%IDC_CALENDAR =  1500
%IDC_BUTTON   =  1505

Function WndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) Export As Long
  Local dwStyle,dwExStyle,hCalFont,hCal,hBtn,hInst As Dword
  Local st As SYSTEMTIME
  Local hDC As Long

  Select Case wMsg
    Case %WM_CREATE
      hInst=GetModuleHandle(Byval %NULL)
      hDC=GetDC(hWnd)
      dwExStyle=%WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR
      dwStyle=%WS_BORDER Or %WS_CHILD Or %WS_VISIBLE Or %MCS_DAYSTATE
      hCal=CreateWindowEx(dwExStyle,"SYSMONTHCAL32","",dwStyle,5,5,306,255,hWnd,%IDC_CALENDAR,hInst,ByVal %Null)
      hCalFont=CreateFont(20,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
      Call SendMessage(hCal,%WM_SETFONT,hCalFont,1)
      Call ReleaseDC(hWnd,hDC)
      hBtn=CreateWindowEx(0,"button","Change Date",%WS_CHILD Or %WS_VISIBLE,110,265,100,25,hWnd,%IDC_BUTTON,hInst,Byval %NULL)
      WndProc=0
      Exit Function
    Case %WM_SIZE
      MonthCal_GetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
      MsgBox("Today Is " & Trim$(Str$(st.wMonth)) & "/" & Trim$(Str$(st.wDay)) & "/" & Trim$(Str$(st.wYear)))
      WndProc=0
      Exit Function
    Case %WM_COMMAND
      If HiWrd(wParam)=%BN_CLICKED And LoWrd(wParam)=%IDC_BUTTON Then
         st.wDay=15
         st.wMonth=11
         st.wYear=1952
         MonthCal_SetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
         MsgBox("You Are Now Looking At My Birthday.  Next Year I'll" & Chr$(13) & Chr$(10) & "Be Looking For A Birthday Card!")
      End If
      WndProc=0
      Exit Function
    Case %WM_DESTROY
      Call PostQuitMessage(0)
      WndProc=0
      Exit Function
  End Select

  WndProc=DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function

Function WinMain(ByVal hIns As Long, ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr, ByVal iShow As Long) As Long
  Local uCC As INIT_COMMON_CONTROLSEX
  Local winclass As WndClassEx
  Local szAppName As Asciiz*16
  Local hWnd As Dword
  Local Msg As tagMsg

  szAppName="Calendar"
  uCC.dwSize = SizeOf(uCC)
  uCC.dwICC  = %ICC_DATE_CLASSES
  Call InitCommonControlsEx(uCC)
  winclass.cbSize=SizeOf(winclass)
  winclass.style=%CS_HREDRAW Or %CS_VREDRAW
  winclass.lpfnWndProc=CodePtr(WndProc)
  winclass.cbClsExtra=0
  winclass.cbWndExtra=0
  winclass.hInstance=hIns
  winclass.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  winclass.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
  winclass.hbrBackground=%COLOR_BTNFACE+1
  winclass.lpszMenuName=%NULL
  winclass.lpszClassName=VarPtr(szAppName)
  RegisterClassEx winclass
  hWnd=CreateWindowEx(0,szAppName,"Calendar",%WS_OVERLAPPEDWINDOW,200,100,325,330,0,0,hIns,ByVal 0)
  ShowWindow hWnd,iShow
  UpdateWindow hWnd
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend

  Function=msg.wParam
End Function

To see the effect of the changing of the font in the above examples, you can comment out the four lines under the WM_CREATE message in the above examples that deal with fonts, that is...

'hDC=GetDC(hWnd)
'hCalFont=CreateFont(20,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
'Call SendMessage(hCal,%WM_SETFONT,hCalFont,1)
'Call ReleaseDC(hWnd,hDC)

...and the program will still work.

[Bill Scharf]

Fed,

Thanks for the concise example.
My problem can be illustrated with this code:

#COMPILE EXE
#DIM ALL
#INCLUDE "h:\source07\winapi\Win32api.inc"
#INCLUDE "h:\source07\winapi\Commctrl.inc"
%IDC_CALENDAR =  1500
%IDC_BUTTON   =  1505

FUNCTION WndProc(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) EXPORT AS LONG
  LOCAL dwStyle,dwExStyle,hCalFont,hCal,hBtn,hInst AS DWORD
  LOCAL st AS SYSTEMTIME
  LOCAL hDC AS LONG

  SELECT CASE wMsg
    CASE %WM_CREATE
      hInst=GetModuleHandle(BYVAL %NULL)
      hDC=GetDC(hWnd)
      dwExStyle=%WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
      dwStyle=%WS_BORDER OR %WS_CHILD OR %WS_VISIBLE OR %MCS_DAYSTATE
      hCal=CreateWindowEx(dwExStyle,"SYSMONTHCAL32","",dwStyle,5,5,306,255,hWnd,%IDC_CALENDAR,hInst,BYVAL %Null)
      hCalFont=CreateFont(20,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
      CALL SendMessage(hCal,%WM_SETFONT,hCalFont,1)
      CALL ReleaseDC(hWnd,hDC)
      hBtn=CreateWindowEx(0,"button","Change Date",%WS_CHILD OR %WS_VISIBLE,110,265,100,25,hWnd,%IDC_BUTTON,hInst,BYVAL %NULL)
      WndProc=0
      EXIT FUNCTION
    CASE %WM_SIZE
      MonthCal_GetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
      MSGBOX("Today Is " & TRIM$(STR$(st.wMonth)) & "/" & TRIM$(STR$(st.wDay)) & "/" & TRIM$(STR$(st.wYear)))
      WndProc=0
      EXIT FUNCTION
    CASE %WM_NOTIFY
        IF LOWRD(wParam)= %IDC_CALENDAR THEN
            LOCAL pNMSC AS NMSELCHANGE PTR
            pNMSC = LPARAM

            IF @pNMSC.hdr.code = %MCN_SELCHANGE THEN
               MSGBOX "date changed"
            END IF
             IF @pNMSC.hdr.code = %MCN_GETDAYSTATE THEN
               MSGBOX "%MCN_GETDAYSTATE"
            END IF
            

        END IF
    CASE %WM_COMMAND
      IF HIWRD(wParam)=%BN_CLICKED AND LOWRD(wParam)=%IDC_BUTTON THEN
         st.wDay=15
         st.wMonth=11
         st.wYear=1952
         MonthCal_SetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
         MSGBOX("You Are Now Looking At My Birthday.  Next Year I'll" & CHR$(13) & CHR$(10) & "Be Looking For A Birthday Card!")
      END IF
      WndProc=0
      EXIT FUNCTION
    CASE %WM_DESTROY
      CALL PostQuitMessage(0)
      WndProc=0
      EXIT FUNCTION
  END SELECT

  WndProc=DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION

FUNCTION WINMAIN(BYVAL hIns AS LONG, BYVAL hPrev AS LONG,BYVAL lpCL AS ASCIIZ PTR, BYVAL iShow AS LONG) AS LONG
  LOCAL uCC AS INIT_COMMON_CONTROLSEX
  LOCAL winclass AS WndClassEx
  LOCAL szAppName AS ASCIIZ*16
  LOCAL hWnd AS DWORD
  LOCAL Msg AS tagMsg

  szAppName="Calendar"
  uCC.dwSize = SIZEOF(uCC)
  uCC.dwICC  = %ICC_DATE_CLASSES
  CALL InitCommonControlsEx(uCC)
  winclass.cbSize=SIZEOF(winclass)
  winclass.style=%CS_HREDRAW OR %CS_VREDRAW
  winclass.lpfnWndProc=CODEPTR(WndProc)
  winclass.cbClsExtra=0
  winclass.cbWndExtra=0
  winclass.hInstance=hIns
  winclass.hIcon=LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
  winclass.hCursor=LoadCursor(%NULL, BYVAL %IDC_ARROW)
  winclass.hbrBackground=%COLOR_BTNFACE+1
  winclass.lpszMenuName=%NULL
  winclass.lpszClassName=VARPTR(szAppName)
  RegisterClassEx winclass
  hWnd=CreateWindowEx(0,szAppName,"Calendar",%WS_OVERLAPPEDWINDOW,200,100,325,330,0,0,hIns,BYVAL 0)
  ShowWindow hWnd,iShow
  UpdateWindow hWnd
  WHILE GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  WEND

  FUNCTION=msg.wParam
END FUNCTION

When you click the button, it seems that the %MCN_GETDAYSTATE is fired and not the %MCN_SELCHANGE. I would expect the %MCN_SELCHANGE to happen. Is there some better way to set the date so that the %MCN_SELCHANGE message will occur?

[Fred Harris]

I noticed that the "date changed" message box pops up when you manually click on any date. Isn't that good enough? To get a %MCN_SELCHANGE message, I'd expect the selection in the calendar must change, that is, if someone clicked on some date other than the one currently selected?

[Fred Harris]

SendMessage() yourself a message

You can always SendMessage() any message you want. If you want a MCN_SELCHANGE message, then just send yourself one as follows...

#Compile Exe
#Dim All
#Include "Win32api.inc"
#Include "Commctrl.inc"
%IDC_CALENDAR =  1500
%IDC_BUTTON   =  1505

Function WndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) Export As Long
  Local dwStyle,dwExStyle,hCalFont,hCal,hBtn,hInst As Dword
  Local st As SYSTEMTIME
  Local hDC As Long

  Select Case wMsg
    Case %WM_CREATE
      hInst=GetModuleHandle(Byval %NULL)
      hDC=GetDC(hWnd)
      dwExStyle=%WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR
      dwStyle=%WS_BORDER Or %WS_CHILD Or %WS_VISIBLE Or %MCS_DAYSTATE
      hCal=CreateWindowEx(dwExStyle,"SYSMONTHCAL32","",dwStyle,5,5,306,255,hWnd,%IDC_CALENDAR,hInst,ByVal %Null)
      hCalFont=CreateFont(20,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
      Call SendMessage(hCal,%WM_SETFONT,hCalFont,1)
      Call ReleaseDC(hWnd,hDC)
      hBtn=CreateWindowEx(0,"button","Change Date",%WS_CHILD Or %WS_VISIBLE,110,265,100,25,hWnd,%IDC_BUTTON,hInst,Byval %NULL)
      WndProc=0
      Exit Function
    Case %WM_COMMAND
      If HiWrd(wParam)=%BN_CLICKED And LoWrd(wParam)=%IDC_BUTTON Then
         st.wDay=15
         st.wMonth=11
         st.wYear=1952
         MonthCal_SetCurSel(GetDlgItem(hWnd,%IDC_CALENDAR),st)
         Local lpMsg As NMSELCHANGE
         lpMsg.hdr.code=%MCN_SELCHANGE
         SendMessage(hWnd,%WM_NOTIFY,%IDC_CALENDAR,Varptr(lpMsg))
         MsgBox("You Are Now Looking At My Birthday.  Next Year I'll" & Chr$(13) & Chr$(10) & "Be Looking For A Birthday Card!")
      End If
      WndProc=0
      Exit Function
    Case %WM_NOTIFY
      If Lowrd(wParam)=%IDC_CALENDAR Then
         Local pNMSC AS NMSELCHANGE Ptr
         pNMSC=LPARAM
         If @pNMSC.hdr.code = %MCN_SELCHANGE Then
            MSGBOX "date changed"
         End If
      End If
      WndProc=0
      Exit Function
    Case %WM_DESTROY
      Call PostQuitMessage(0)
      WndProc=0
      Exit Function
  End Select

  WndProc=DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function

Function WinMain(ByVal hIns As Long, ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr, ByVal iShow As Long) As Long
  Local uCC As INIT_COMMON_CONTROLSEX
  Local winclass As WndClassEx
  Local szAppName As Asciiz*16
  Local hWnd As Dword
  Local Msg As tagMsg

  szAppName="Calendar"
  uCC.dwSize = SizeOf(uCC)
  uCC.dwICC  = %ICC_DATE_CLASSES
  Call InitCommonControlsEx(uCC)
  winclass.cbSize=SizeOf(winclass)
  winclass.style=%CS_HREDRAW Or %CS_VREDRAW
  winclass.lpfnWndProc=CodePtr(WndProc)
  winclass.cbClsExtra=0
  winclass.cbWndExtra=0
  winclass.hInstance=hIns
  winclass.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  winclass.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
  winclass.hbrBackground=%COLOR_BTNFACE+1
  winclass.lpszMenuName=%NULL
  winclass.lpszClassName=VarPtr(szAppName)
  RegisterClassEx winclass
  hWnd=CreateWindowEx(0,szAppName,"Calendar",%WS_OVERLAPPEDWINDOW,200,100,325,330,0,0,hIns,ByVal 0)
  ShowWindow hWnd,iShow
  UpdateWindow hWnd
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend

  Function=msg.wParam
End Function

[Bill Scharf]

Fred,

Thanks for the sample code. I thought I might be doing something wrong. A coworker pointed out to me that the MCN_SELCHANGEmessage is not suppossed to be sent if the date is changed programatically. Thank you for your help. Your latest example is a good solution to what I was trying to do.

[Michael Mattias]

A coworker pointed out to me that the MCN_SELCHANGE message is not suppossed to be sent if the date is changed programatically

Any time a notification is not sent when you might expect it, it is documented. This is not documented. Suggestion for co-worker:

MCM