Lebans Calendar

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 )
 
StuKo said:
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 )
Click to expand...

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:
Uncle Gizmo said:
How do you incorporate the dates in to your Code?
Click to expand...
See my previous post #25. There are detailed instructions included in the file explaining how to incorporate the calendar into your project.
 
Uncle Gizmo said:
How do you incorporate the dates in to your Code?
Click to expand...
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
 
KingOfPuns said:
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.
Click to expand...
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:
StuKo said:
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.
Click to expand...
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.
 
You must log in or register to reply here.

Similar threads

C
Automated Production Planner
Replies
11
Views
1,532
GPGeorge
GPGeorge
A
Calendar events but not in Outlook
Replies
9
Views
1,460
theDBguy
theDBguy
Isaac
How to Find Source of Google Credit Card Charge
Replies
5
Views
517
Isaac
Isaac
riktek
Best approach for temporary A2003 installation
Replies
7
Views
545
riktek
riktek
amorosik
There's a system for Access similar to Gemini Code Assist for Visual Studio.
Replies
7
Views
1,155
GPGeorge
GPGeorge

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom