Lebans Calendar

I tried a bit to do the conversion. Rather than LongLong you should use LongPtr in most places, however, I still did not get it to work. When creating a the object of clsMonthCal and using the ShowRangeCal to initate, I get as far as the WindowProc call (initiated by the apiCreateWindowEx call in the modCalendar.ShowMonthCalendar function) and Access simply crashes silently (App Event Log shows either a EventID 1000 or 1002).


I used the Win32API SafePtr reference (Win32API_PtrSafe.txt -see txt file for URL as wouldn't let me post with it inline) to determine what param and returns need to LongPtr and then extrapolated what local/global var's may need to be based on their receiving result of functions or placed as parameters. Attached are the rough outline of changes I made. If anyone would care to double-check and then help further trouble-shoot, that would be awesome.
 

Attachments

opening this up - has anyone converted the Lebans one to 64 bit. The reason I like it is the that a person can select a date span, and as far as I can tell no other calendar does that.

I tried converting Lebans by using PtrSafe and LongLong etc but made a right mess of it... won't compile and some of the declare are not behaving with LongLong ...
I see your question is almost a year old. I thought I would reply to it anyhow just in case you were still looking.

All too often I need a calendar that shows more than just one month. That is why I much prefer Leban’s calendar to any other calendar I have used. I like the fact that you can select the number of months to display and as you mentioned, one can select consecutive days. Your correct in stating no other calendar has these features.

I decided I needed to modify my applications to run in 64-bit because Microsoft is installing 64-bit office by default in new computers. I do not want to ask my clients to uninstall 64-bit and download and install 32-bit. I feel it is best from a business relations point of view to have my applications run on whatever my clients have on their machines.

I have just finished modifying the codes for Leban’s month calendar to work in both 32-bit and 64-bit access. At least it seems to function good on both my 32- and 64-bit machines.

If you are still interested in obtaining the codes let me know.
 
I use Lebans MonthCalender since many years and I appreciate the feature of being able to select a period defined by a start date and an end date. So far I have not found a calendar that offers this possibility and runs on 64-bit Access. It would be very kind if you could provide me the code.

I do not know if you noticed the bug in Lebans original code with die Show Today Option (see my Post Lebans Calendar - Show Today issue )
 
I use Lebans MonthCalender since many years and I appreciate the feature of being able to select a period defined by a start date and an end date. So far I have not found a calendar that offers this possibility and runs on 64-bit Access. It would be very kind if you could provide me the code.

I do not know if you noticed the bug in Lebans original code with die Show Today Option (see my Post Lebans Calendar - Show Today issue )

Yes, I knew there was a bug in the Show Today option however, I decided not to bother with it. I felt having today’s date circled was sufficient.

I commented out the code for it as well as the Font Menu code. I really do not need either of these two menu items so I decided not to display them under the Properties menu in my version. If you want to display either one or both look for the following lines in modCalendar_x64.

Code:
Function ShowMonthCalendar

' Font stuff SubMenu    UNCOMMENT THE FOLLOWING TWO LINES TO DISPLAY FONT MENU
    '        lngRet = InsertMenu(hMenuPopMisc, 2&, MF_POPUP Or MF_BYPOSITION Or MF_ENABLED, hMenuPopMiscFont, "Font")
    '        lngRet = InsertMenu(hMenuPopMiscFont, 0&, MF_STRING Or MF_BYPOSITION, FontDialog, "Select Font")

' Show Today's Date UNCOMMENT THE FOLLOWING THREE LINES TO DISPLAY SHOW TODAY'S DATE MENU
    '        lngRet = InsertMenu(hMenuPopMisc, 4&, MF_POPUP Or MF_BYPOSITION Or MF_ENABLED, hMenuPopMiscToday, "Show Today")
    '        lngRet = InsertMenu(hMenuPopMiscToday, 0&, MF_STRING Or MF_BYPOSITION, ShowTodayYES, "YES")
    '        lngRet = InsertMenu(hMenuPopMiscToday, 0&, MF_STRING Or MF_BYPOSITION, ShowTodayNO, "NO")

I strongly suggest you review the error handling and write your own error message. I commented out the error messages because I have it calling a log error function which stores the error information in a table.

This modified version of Stephen Lebans Month Calendar works in both 32-bit and 64-bit applications.
I wish you the best with your projects.
 

Attachments

Last edited:
I asked because I have my own calendar date Selection Form and it's primary return is is a Between SQL Statement including the two dates selected which handley works in any SQL Statement that needs a set of dates.

By default, it returns the Between Statement to the Tag property of the control that called it. You can then incorporate it in your SQL.
 
How do you incorporate the dates in to your Code?
this is my code in the form
Code:
Option Compare Database
Option Explicit

' This declares the MonthCalendar Class
Private mc As clsMonthCal

Private Sub cmdOpenCal_Click()
    Dim blRet As Boolean
    Dim dtStart As Date, dtEnd As Date
    
    dtStart = Nz(Me.txtStartDate.Value, 0)
    dtEnd = 0
    
    blRet = ShowMonthCalendar(mc, dtStart, dtEnd)
    If blRet = True Then
        Me.txtStartDate = dtStart
        Me.txtEndDate = dtEnd
    Else
    ' Add any message here if you want to
    ' inform the user that no date was selected
    End If
End Sub

Private Sub Form_Load()
    ' Create an instance of our Class
    Set mc = New clsMonthCal
    ' Set the hWndForm Property
    mc.hWndForm = Me.hWnd
End Sub
 
Yes, I knew there was a bug in the Show Today option however, I decided not to bother with it. I felt having today’s date circled was sufficient.

I commented out the code for it as well as the Font Menu code. I really do not need either of these two menu items so I decided not to display them under the Properties menu in my version. If you want to display either one or both look for the following lines in modCalendar_x64.

Code:
Function ShowMonthCalendar

' Font stuff SubMenu    UNCOMMENT THE FOLLOWING TWO LINES TO DISPLAY FONT MENU
    '        lngRet = InsertMenu(hMenuPopMisc, 2&, MF_POPUP Or MF_BYPOSITION Or MF_ENABLED, hMenuPopMiscFont, "Font")
    '        lngRet = InsertMenu(hMenuPopMiscFont, 0&, MF_STRING Or MF_BYPOSITION, FontDialog, "Select Font")

' Show Today's Date UNCOMMENT THE FOLLOWING THREE LINES TO DISPLAY SHOW TODAY'S DATE MENU
    '        lngRet = InsertMenu(hMenuPopMisc, 4&, MF_POPUP Or MF_BYPOSITION Or MF_ENABLED, hMenuPopMiscToday, "Show Today")
    '        lngRet = InsertMenu(hMenuPopMiscToday, 0&, MF_STRING Or MF_BYPOSITION, ShowTodayYES, "YES")
    '        lngRet = InsertMenu(hMenuPopMiscToday, 0&, MF_STRING Or MF_BYPOSITION, ShowTodayNO, "NO")

I strongly suggest you review the error handling and write your own error message. I commented out the error messages because I have it calling a log error function which stores the error information in a table.

This modified version of Stephen Lebans Month Calendar works in both 32-bit and 64-bit applications.
I wish you the best with your projects.
I added my own error handler "LogError". Your code works perfect. Thanks a lot.
I only had the small issue that the height of the calendar was too small compared to Lebans code. Compared to the original code I found the following difference in the ReDraw procedure in clsMonthCal:

Original code:
Code:
' Get rectangle for our Form
'Debug.Print "GetWindowRect- Me.hWnd:" & m_Form.hWnd
'lngRet = GetWindowRect(m_Hwnd, rc1)
'lngRet = GetClientRect(m_Hwnd, rc2)
' Get rectangle for our Calendar
    lngRet = GetWindowRect(m_hWndDTP, rc3)
    lngRet = GetWindowLong(m_Hwnd, GWL_STYLE)
    lngRet = AdjustWindowRect(rc3, lngRet, -1)  'uses the lngRet value of the previous line
The x64 code
Code:
    lngRet = GetWindowRect(m_hWndDTP, rc3)
    lngRetPtr = GetWindowLongPtr(m_Hwnd, GWL_STYLE)
    'lngRet = AdjustWindowRect(rc3, lngRet, -1) 'uses the lngRet value of the first line
    lngRet = AdjustWindowRect(rc3, CLng(lngRetPtr), -1)
I tried to fix this with "lngRet = AdjustWindowRect(rc3, lngRet, -1)", which works in 32 bit Access but crashes in a 64 bit application.
 
Last edited:
I added my own error handler "LogError". Your code works perfect. Thanks a lot.
I only had the small issue that the height of the calendar was too small compared to Lebans code. Compared to the original code I found the following difference in the ReDraw procedure in clsMonthCal:

Original code:
Code:
' Get rectangle for our Form
'Debug.Print "GetWindowRect- Me.hWnd:" & m_Form.hWnd
'lngRet = GetWindowRect(m_Hwnd, rc1)
'lngRet = GetClientRect(m_Hwnd, rc2)
' Get rectangle for our Calendar
    lngRet = GetWindowRect(m_hWndDTP, rc3)
    lngRet = GetWindowLong(m_Hwnd, GWL_STYLE)
    lngRet = AdjustWindowRect(rc3, lngRet, -1)  'uses the lngRet value of the previous line
The x64 code
Code:
    lngRet = GetWindowRect(m_hWndDTP, rc3)
    lngRetPtr = GetWindowLongPtr(m_Hwnd, GWL_STYLE)
    'lngRet = AdjustWindowRect(rc3, lngRet, -1) 'uses the lngRet value of the first line
    lngRet = AdjustWindowRect(rc3, CLng(lngRetPtr), -1)
I tried to fix this with "lngRet = AdjustWindowRect(rc3, lngRet, -1)", which works in 32 bit Access but crashes in a 64 bit application.
Are you sure that is the only difference you found between the two codes in the ReDraw procedure?
This change from the original code should have appeared immediately before the code you mentioned.


Code:
' Resize the Month Calendar to display the user selected
    ' number of months. The CalendarYOffset is used to allow
    ' any controls we have placed at the Top of our Form
    ' to be visible.
    ' ***DEBUG - BUG FIX ******
    ' Try to fix visual display bug
    ' when only 1 month is selected.
    ' The left most column dissappears when
    ' when selecting a range of dates
    ' Add 4 pixels to the COntrol's Width

    If m_MonthRows = 1 And m_MonthColumns <= 3 Then     '<------------------------***EDITED: One to three months displayed***
        Call apiSetWindowPos(m_hWndDTP, 0&, 0&, _
                             0&, lngTempRight + 20, lngTempBottom + 40, 0&)     '<------------------------***EDIT these values to adjust width and height of calendar***

    Else    'Four or more months displayed
        Call apiSetWindowPos(m_hWndDTP, 0&, 0&, _
                             0&, lngTempRight + 20, lngTempBottom + 20, 0&)     '<------------------------***EDIT these values to adjust width and height of calendar***
    End If

Maybe the file I uploaded didn't have my latest revision of the clsMouthCal module in it. I do not know.
I just tested the calendar in 64-bit with each of the different number of mouths shown and I have no issues with.
It works fine for me.
 

Users who are viewing this thread

Back
Top Bottom