Windows Analysis Report
samradapps_datepicker_221114.xlam

Attribute VB_Name = "DatePickerManager"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

'hooks into Excel objects
Private WithEvents c1App As Application
Attribute c1App.VB_VarHelpID = -1

'local vars
Private m_PickerVisible As Boolean

'**************************************************************
'CLASS EVENTS
'**************************************************************

'INIT
Private Sub Class_Initialize()
    On Error Resume Next

    'get the application object
    Set c1App = Application
    
    'set the defaults
    m_PickerVisible = False
    
    On Error GoTo 0
End Sub

'TERMINATE
Private Sub Class_Terminate()
    clearAllUI
End Sub

'**************************************************************
'PROPERTIES
'**************************************************************

'Date Picker Visible Tracking
Public Property Get PickerVisible() As Variant
    PickerVisible = m_PickerVisible
End Property
Public Property Let PickerVisible(ByVal vNewValue As Variant)
    m_PickerVisible = vNewValue
End Property

'**************************************************************
'SHARED UPDATES
'**************************************************************

'sheet changed
Private Sub DoSheetChange()
    clearAllUI
    processSelectionChange
End Sub

'workbook changed
Private Sub DoWorkbookChange()
    DoSheetChange
End Sub

'clear all UI
Private Sub clearAllUI()
    closeDatePicker
    killGridDP
End Sub

'process the cell changing
Private Sub processSelectionChange()
    'clear the ui
    clearAllUI
    
    'see if we should show the DP icon
    If checkForGridDP Then
        'show the date picker
        createGridDP
    End If
End Sub

'called to see if we should show the dp entry point in the grid
Private Function checkForGridDP() As Boolean
    On Error GoTo check_err
    
    'ref to cell above
    Dim cellAbove As Range
    
    'default to false
    checkForGridDP = False
    
    'be sure the flag is enabled
    If (fShowDPInGrid) Then
        'check to see if active cell is a range
        If TypeName(ActiveCell) = "Range" Then
            'check the current cell's value
            If VBA.IsDate(ActiveCell) Or ActiveCell.NumberFormat Like "*[Dd]*" Then
                'show the shape dp
                checkForGridDP = True
            Else
                'exit out if its populated but not a date
                If ActiveCell <> "" Then Exit Function
                
                'make sure we aren't in the top row
                If ActiveCell.Row <> 1 Then
                    'get the cell above
                    Set cellAbove = ActiveCell.Offset(-1, 0)
                    
                    'check to see if the cell above has the word date in it, or if its a date
                    If InStr(1, cellAbove, "date", vbTextCompare) > 0 Or VBA.IsDate(cellAbove) Then
                        'show the shape dp
                        checkForGridDP = True
                    End If
                End If
            End If
        End If
    End If
    
check_err:
End Function

'**************************************************************
'APP EVENTS
'**************************************************************

Private Sub c1App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    DoSheetChange
End Sub

'App New workbook created
Private Sub c1App_NewWorkbook(ByVal Wb As Workbook)
    DoWorkbookChange
End Sub

'App before print
Private Sub c1App_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    clearAllUI
End Sub

'App before save
Private Sub c1App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    clearAllUI
End Sub

'App window resize
Private Sub c1App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
    closeDatePicker
End Sub

'App sheet activated
Private Sub c1App_SheetActivate(ByVal Sh As Object)
    DoSheetChange
End Sub

'App workbook activated
Private Sub c1App_WorkbookActivate(ByVal Wb As Workbook)
    DoWorkbookChange
End Sub

Attribute VB_Name = "Module1"
Sub Macro1()
Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Macro1 Macro
'

'
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.Unprotect
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("E8").Select
End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit

'init of the samradapps date picker :-)
Private Sub Workbook_Open()
    ensureDPManager
    LoadGlobalSettings
End Sub

Attribute VB_Name = "api_scroll_wheel"
Option Explicit

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const cSCROLLCHANGE As Long = 10
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type
 
Private mFormHwnd As Long
Private mbHook As Boolean

Dim mForm As Object

'********************************************************************
'** 32/64 bit api's
'********************************************************************
#If Win64 Then

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

    Private mLngMouseHook As LongPtr

    'mouse message incoming to form
    Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
        On Error GoTo errH
        If (ncode = HC_ACTION) Then
            If GetActiveWindow = mFormHwnd Then
                'see if its a mouse wheel action
                If wParam = WM_MOUSEWHEEL Then
                    MouseProc = True
                    If lParam.hwnd > 0 Then
                        'scroll up, to go previous month
                        datepickerform.prevMonthButton_Click
                    Else
                        'scroll down, go to next month
                        datepickerform.nextMonthButton_Click
                    End If
                    Exit Function
                End If
            End If
        End If
        
        'pass message along
        MouseProc = CallNextHookEx(mLngMouseHook, ncode, wParam, ByVal lParam)
        Exit Function
errH:
        'if there is an error then stop everything
        UnhookFormScroll
    End Function

    'listen to all the mouse events on the form passed in
    Sub DoHookFormScroll(oForm As Object)
        'too unstable on 64 bit
    End Sub
    Sub UnhookFormScroll()
        'too unstable on 64 bit
    End Sub

#Else

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    
    Private mLngMouseHook              As Long
    
    'mouse message incoming to form
    Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
        On Error GoTo errH
        If (ncode = HC_ACTION) Then
            If GetActiveWindow = mFormHwnd Then
                'see if its a mouse wheel action
                If wParam = WM_MOUSEWHEEL Then
                    MouseProc = True
                    If lParam.hwnd > 0 Then
                        'scroll up, to go previous month
                        datepickerform.prevMonthButton_Click
                    Else
                        'scroll down, go to next month
                        datepickerform.nextMonthButton_Click
                    End If
                    Exit Function
                End If
            End If
        End If
        
        'pass message along
        MouseProc = CallNextHookEx(mLngMouseHook, ncode, wParam, ByVal lParam)
        Exit Function
errH:
        'if there is an error then stop everything
        UnhookFormScroll
    End Function

    'listen to all the mouse events on the form passed in
    Sub DoHookFormScroll(oForm As Object)
        Dim lngAppInst                  As Long
        Dim hwndUnderCursor             As Long
         
        Set mForm = oForm
        hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
        If mFormHwnd <> hwndUnderCursor Then
            UnhookFormScroll
            mFormHwnd = hwndUnderCursor
            lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
            If Not mbHook Then
                mLngMouseHook = SetWindowsHookEx(                 WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                mbHook = mLngMouseHook <> 0
            End If
        End If
    End Sub

    'stops listening for all the mouse messages to the form
    Sub UnhookFormScroll()
        If mbHook Then
            UnhookWindowsHookEx mLngMouseHook
            mLngMouseHook = 0
            mFormHwnd = 0
            mbHook = False
        End If
    End Sub

#End If

Attribute VB_Name = "api_title_mouse_timer"
Option Explicit

'********************************************************************
'** 32/64 bit api's
'********************************************************************
#If Win64 Then

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (p As theCursor) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    
    Dim TimerID As LongPtr
    Dim hdc As LongPtr
    Dim mhWndForm As LongPtr
    
#Else
    
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (p As theCursor) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    
    Dim TimerID As Long
    Dim hdc As Long
    Dim mhWndForm As Long
    
#End If

'used for conversion of mouse to form positoning
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

'mouse position
Public Type theCursor
    Left As Long
    Top As Long
End Type

'timer options
Dim TimerSeconds As Single, tim As Boolean, Counter As Long

'used to get the screen height info
Private Const SM_CXMAXIMIZED = 61
Private Const SM_CYMAXIMIZED = 62

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

Public g_screenHeight As Long
Public g_screenWidth As Long

'converts X position for mouse
Private Function pointsPerPixelX() As Double
    hdc = GetDC(0)
    pointsPerPixelX = 72 / GetDeviceCaps(hdc, LOGPIXELSX)
    ReleaseDC 0, hdc
End Function

'converts Y position for mouse
Private Function pointsPerPixelY() As Double
    hdc = GetDC(0)
    pointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
    ReleaseDC 0, hdc
End Function

Public Sub getScreenHeight()
    'get the screen height
    g_screenHeight = GetSystemMetrics32(SM_CYMAXIMIZED)
    g_screenHeight = g_screenHeight * pointsPerPixelY
    
    'get the screen width
    g_screenWidth = GetSystemMetrics32(SM_CXMAXIMIZED)
    g_screenWidth = g_screenWidth * pointsPerPixelX
    
    'bump for some comfort space
    g_screenHeight = g_screenHeight - 20
    g_screenWidth = g_screenWidth - 20
    
    'check to be sure we have a generally positive number
    If g_screenHeight < 300 Then g_screenHeight = 300
    If g_screenWidth < 300 Then g_screenWidth = 300
End Sub

'positions the passed in form's top/left to the current mouse position
Sub MoveFormToMouse(theForm)

    Dim mousePos As theCursor
    
    'get the position of the mouse
    GetCursorPos mousePos
    
    'set the form postion to the mouse position
    theForm.Top = pointsPerPixelX * mousePos.Top
    theForm.Left = pointsPerPixelY * mousePos.Left
    
    'make sure we don't run off the bottom
    If g_screenHeight > 0 Then
        If (theForm.Top + theForm.Height) > g_screenHeight Then theForm.Top = g_screenHeight - theForm.Height
    End If
    
    'make sure we don't run off the right
    If g_screenWidth > 0 Then
        If (theForm.Left + theForm.Width) > g_screenWidth Then theForm.Left = g_screenWidth - theForm.Width
    End If
    
End Sub


'********************************************************
'TIMER
'********************************************************

'starts the timer
Sub StartTimer()
    'set the timer for 1 second
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'stops the timer
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

'timer called on the second, update the calendar clock
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    If IsUserFormLoaded("datepickerform") Then
        datepickerform.timeButton.Caption = VBA.Time
    Else
        EndTimer
    End If
End Sub

'checks to see if a particular form is loaded
Private Function IsUserFormLoaded(ByVal UFName As String) As Boolean
    Dim UForm As Object
    For Each UForm In VBA.UserForms
        IsUserFormLoaded = UForm.Name = UFName
        If IsUserFormLoaded Then
            Exit For
        End If
    Next
End Function

'********************************************************
'REMOVE TITLE BAR
'********************************************************

'hides the caption for a userform
Sub removeCaption(objForm As Object)
    Dim lStyle As Long
    Dim hMenu As Long
     
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
    Else
        mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
    End If
    
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
End Sub

Attribute VB_Name = "datepickerform"
Attribute VB_Base = "0{3C78821A-383B-4A45-9982-DBC74EB6A17E}{28BCA504-84B0-4B16-950E-B8D24AF28465}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

Dim cHighlight As Integer       'current day that has the highlight
Dim c1Highlight_Picker As Integer 'current picker highlight

'click on the month picker
Private Sub monthTitle_Click()

    'set the special highlight
    highlightPicker = cMonth
    
    'reset the current highlight
    c1Highlight_Picker = 0
    
    'show the picker
    toggleMonthPicker
    
End Sub

'click on the year picker
Private Sub yearTitle_Click()

    'set the special highlight
    highlightPicker = cYear
    
    'reset the current highlight
    c1Highlight_Picker = 0
    
    'show the picker
    toggleYearPicker
    
End Sub

'next month button click
Public Sub nextMonthButton_Click()
    
    If pickerMode = 0 Then
        'move the month by one
        cMonth = cMonth + 1
        
        'make sure its a valid month
        If cMonth > 12 Then
            cMonth = 1
            cYear = cYear + 1
        End If
        
        'populate the calendar
        populateDatePickerDays
    
    ElseIf pickerMode = 2 Then
        'move to the next set of picker years
        pickerYearsOffset = pickerYearsOffset + 3
        
        'update the picker
        populatePickerYears
    End If
    
End Sub

'previous month button click
Public Sub prevMonthButton_Click()

    If pickerMode = 0 Then
        'move the month by one
        cMonth = cMonth - 1
        
        'make sure its a valid month
        If cMonth < 1 Then
            cMonth = 12
            cYear = cYear - 1
        End If
        
        'populate the calendar
        populateDatePickerDays
    
    ElseIf pickerMode = 2 Then
        'move to previous set of picker years
        pickerYearsOffset = pickerYearsOffset - 3
        
        'update the picker
        populatePickerYears
    End If
    
End Sub

Private Sub UserForm_Initialize()
    
    'get rid of the title bar
    removeCaption Me
    
    'once the borders are gone, we need to resize it to fit the content
    Me.Width = redBG.Width
    Me.Height = barHeight.Height
        
    'init the weekday names
    populateWeekdayNames
    
    'populate the calendar
    populateDatePickerDays
    
    'set the current date and time
    todayButton.Caption = VBA.WeekdayName(VBA.Weekday(VBA.Date, vbSunday)) & ", " & VBA.MonthName(VBA.Month(VBA.Date)) & " " & VBA.day(VBA.Date) & ", " & VBA.Year(VBA.Date)
    timeButton.Caption = VBA.Time
    
    'default the mode
    setPickerMode 0
    
    'start clock timer
    StartTimer
    
End Sub

'processes the mouse move highlight
Sub process2MM(day)

    'see if there is an active highlight
    If cHighlight <> 0 Then
        'see if we need to highlight something else
        If cHighlight <> day Then
            'remove the current highlight
            If cHighlight <= 67 Then
                'remove current highlight
                Me.Controls("daybg" & cHighlight).BackColor = "16777215"
                
                'check to see if its a special date
                specialHighlight Me.Controls("daybg" & cHighlight)
            ElseIf cHighlight = 68 Then
                'insert today button
                datetimebg.BackColor = "16777215"
            ElseIf cHighlight = 69 Then
                'month title caption
                monthTitle.Font.Underline = False
            ElseIf cHighlight = 70 Then
                'year title caption
                yearTitle.Font.Underline = False
            End If
        End If
    End If
    
    'see if we need to apply a new highlight
    If day > 0 Then
        'need to apply new highlight
        If day <= 67 Then
            Me.Controls("daybg" & day).BackColor = "14737632"
        ElseIf day = 68 Then
            'insert today button
            datetimebg.BackColor = "14737632"
        ElseIf day = 69 Then
            'month title caption
            monthTitle.Font.Underline = True
        ElseIf day = 70 Then
            'year title caption
            yearTitle.Font.Underline = True
        End If
        
        'store that its highlighted
        cHighlight = day
    End If
    
End Sub

'process the mouse move with the picker UI
Private Sub process1MMpicker(itemIndex As Integer)
    
    'see if there is an active highlight
    If c1Highlight_Picker <> 0 Then
        'see if we need to highlight something else
        If c1Highlight_Picker <> itemIndex Then
            'remove current highlight
            Me.Controls("mybg" & c1Highlight_Picker).BackColor = "16777215"
            
            'check to see if we should highlight
            specialHighlight Me.Controls("mybg" & c1Highlight_Picker), True
        End If
    End If
    
    'see if we need to apply a new highlight
    If itemIndex > 0 Then
        Me.Controls("mybg" & itemIndex).BackColor = "14737632"
        c1Highlight_Picker = itemIndex
    End If
    
End Sub

'on userform mouse move clear the highlights
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    process2MM 0
End Sub

'on header mouse move clear the highlights
Private Sub redBG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    process2MM 0
End Sub

'*****************************************
'bunch of mouse click handling for the days
'*****************************************
Private Sub day11_Click(): dayPicked 11: End Sub
Private Sub day12_Click(): dayPicked 12: End Sub
Private Sub day13_Click(): dayPicked 13: End Sub
Private Sub day14_Click(): dayPicked 14: End Sub
Private Sub day15_Click(): dayPicked 15: End Sub
Private Sub day16_Click(): dayPicked 16: End Sub
Private Sub day17_Click(): dayPicked 17: End Sub
Private Sub daybg11_Click(): dayPicked 11: End Sub
Private Sub daybg12_Click(): dayPicked 12: End Sub
Private Sub daybg13_Click(): dayPicked 13: End Sub
Private Sub daybg14_Click(): dayPicked 14: End Sub
Private Sub daybg15_Click(): dayPicked 15: End Sub
Private Sub daybg16_Click(): dayPicked 16: End Sub
Private Sub daybg17_Click(): dayPicked 17: End Sub
Private Sub day21_Click(): dayPicked 21: End Sub
Private Sub day22_Click(): dayPicked 22: End Sub
Private Sub day23_Click(): dayPicked 23: End Sub
Private Sub day24_Click(): dayPicked 24: End Sub
Private Sub day25_Click(): dayPicked 25: End Sub
Private Sub day26_Click(): dayPicked 26: End Sub
Private Sub day27_Click(): dayPicked 27: End Sub
Private Sub daybg21_Click(): dayPicked 21: End Sub
Private Sub daybg22_Click(): dayPicked 22: End Sub
Private Sub daybg23_Click(): dayPicked 23: End Sub
Private Sub daybg24_Click(): dayPicked 24: End Sub
Private Sub daybg25_Click(): dayPicked 25: End Sub
Private Sub daybg26_Click(): dayPicked 26: End Sub
Private Sub daybg27_Click(): dayPicked 27: End Sub
Private Sub day31_Click(): dayPicked 31: End Sub
Private Sub day32_Click(): dayPicked 32: End Sub
Private Sub day33_Click(): dayPicked 33: End Sub
Private Sub day34_Click(): dayPicked 34: End Sub
Private Sub day35_Click(): dayPicked 35: End Sub
Private Sub day36_Click(): dayPicked 36: End Sub
Private Sub day37_Click(): dayPicked 37: End Sub
Private Sub daybg31_Click(): dayPicked 31: End Sub
Private Sub daybg32_Click(): dayPicked 32: End Sub
Private Sub daybg33_Click(): dayPicked 33: End Sub
Private Sub daybg34_Click(): dayPicked 34: End Sub
Private Sub daybg35_Click(): dayPicked 35: End Sub
Private Sub daybg36_Click(): dayPicked 36: End Sub
Private Sub daybg37_Click(): dayPicked 37: End Sub
Private Sub day41_Click(): dayPicked 41: End Sub
Private Sub day42_Click(): dayPicked 42: End Sub
Private Sub day43_Click(): dayPicked 43: End Sub
Private Sub day44_Click(): dayPicked 44: End Sub
Private Sub day45_Click(): dayPicked 45: End Sub
Private Sub day46_Click(): dayPicked 46: End Sub
Private Sub day47_Click(): dayPicked 47: End Sub
Private Sub daybg41_Click(): dayPicked 41: End Sub
Private Sub daybg42_Click(): dayPicked 42: End Sub
Private Sub daybg43_Click(): dayPicked 43: End Sub
Private Sub daybg44_Click(): dayPicked 44: End Sub
Private Sub daybg45_Click(): dayPicked 45: End Sub
Private Sub daybg46_Click(): dayPicked 46: End Sub
Private Sub daybg47_Click(): dayPicked 47: End Sub
Private Sub day51_Click(): dayPicked 51: End Sub
Private Sub day52_Click(): dayPicked 52: End Sub
Private Sub day53_Click(): dayPicked 53: End Sub
Private Sub day54_Click(): dayPicked 54: End Sub
Private Sub day55_Click(): dayPicked 55: End Sub
Private Sub day56_Click(): dayPicked 56: End Sub
Private Sub day57_Click(): dayPicked 57: End Sub
Private Sub daybg51_Click(): dayPicked 51: End Sub
Private Sub daybg52_Click(): dayPicked 52: End Sub
Private Sub daybg53_Click(): dayPicked 53: End Sub
Private Sub daybg54_Click(): dayPicked 54: End Sub
Private Sub daybg55_Click(): dayPicked 55: End Sub
Private Sub daybg56_Click(): dayPicked 56: End Sub
Private Sub daybg57_Click(): dayPicked 57: End Sub
Private Sub day61_Click(): dayPicked 61: End Sub
Private Sub day62_Click(): dayPicked 62: End Sub
Private Sub day63_Click(): dayPicked 63: End Sub
Private Sub day64_Click(): dayPicked 64: End Sub
Private Sub day65_Click(): dayPicked 65: End Sub
Private Sub day66_Click(): dayPicked 66: End Sub
Private Sub day67_Click(): dayPicked 67: End Sub
Private Sub daybg61_Click(): dayPicked 61: End Sub
Private Sub daybg62_Click(): dayPicked 62: End Sub
Private Sub daybg63_Click(): dayPicked 63: End Sub
Private Sub daybg64_Click(): dayPicked 64: End Sub
Private Sub daybg65_Click(): dayPicked 65: End Sub
Private Sub daybg66_Click(): dayPicked 66: End Sub
Private Sub daybg67_Click(): dayPicked 67: End Sub
Private Sub timeButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): nowPicked 68, Button: End Sub
Private Sub todayButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): nowPicked 68, Button: End Sub
Private Sub datetimebg_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): nowPicked 68, Button: End Sub

'*****************************************
'bunch of mouse moves for the highlights
'*****************************************
Private Sub day11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 11: End Sub
Private Sub day12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 12: End Sub
Private Sub day13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 13: End Sub
Private Sub day14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 14: End Sub
Private Sub day15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 15: End Sub
Private Sub day16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 16: End Sub
Private Sub day17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 17: End Sub
Private Sub daybg11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 11: End Sub
Private Sub daybg12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 12: End Sub
Private Sub daybg13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 13: End Sub
Private Sub daybg14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 14: End Sub
Private Sub daybg15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 15: End Sub
Private Sub daybg16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 16: End Sub
Private Sub daybg17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 17: End Sub
Private Sub day21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 21: End Sub
Private Sub day22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 22: End Sub
Private Sub day23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 23: End Sub
Private Sub day24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 24: End Sub
Private Sub day25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 25: End Sub
Private Sub day26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 26: End Sub
Private Sub day27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 27: End Sub
Private Sub daybg21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 21: End Sub
Private Sub daybg22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 22: End Sub
Private Sub daybg23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 23: End Sub
Private Sub daybg24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 24: End Sub
Private Sub daybg25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 25: End Sub
Private Sub daybg26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 26: End Sub
Private Sub daybg27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 27: End Sub
Private Sub day31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 31: End Sub
Private Sub day32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 32: End Sub
Private Sub day33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 33: End Sub
Private Sub day34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 34: End Sub
Private Sub day35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 35: End Sub
Private Sub day36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 36: End Sub
Private Sub day37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 37: End Sub
Private Sub daybg31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 31: End Sub
Private Sub daybg32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 32: End Sub
Private Sub daybg33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 33: End Sub
Private Sub daybg34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 34: End Sub
Private Sub daybg35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 35: End Sub
Private Sub daybg36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 36: End Sub
Private Sub daybg37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 37: End Sub
Private Sub day41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 41: End Sub
Private Sub day42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 42: End Sub
Private Sub day43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 43: End Sub
Private Sub day44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 44: End Sub
Private Sub day45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 45: End Sub
Private Sub day46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 46: End Sub
Private Sub day47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 47: End Sub
Private Sub daybg41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 41: End Sub
Private Sub daybg42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 42: End Sub
Private Sub daybg43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 43: End Sub
Private Sub daybg44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 44: End Sub
Private Sub daybg45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 45: End Sub
Private Sub daybg46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 46: End Sub
Private Sub daybg47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 47: End Sub
Private Sub day51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 51: End Sub
Private Sub day52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 52: End Sub
Private Sub day53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 53: End Sub
Private Sub day54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 54: End Sub
Private Sub day55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 55: End Sub
Private Sub day56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 56: End Sub
Private Sub day57_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 57: End Sub
Private Sub daybg51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 51: End Sub
Private Sub daybg52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 52: End Sub
Private Sub daybg53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 53: End Sub
Private Sub daybg54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 54: End Sub
Private Sub daybg55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 55: End Sub
Private Sub daybg56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): process2MM 

Attribute VB_Name = "dp_core"
Option Explicit

Global g_oDP As DatePickerManager 'controls the date picker
Global cMonth As Integer 'curent month for the date picker
Global cYear As Integer 'current year for the date picker
Global datePicked As String 'date that get picked and inserted
Global theRibbon As IRibbonUI 'ref to the ribbon
Global fShowDPRightClick As Boolean 'flag if we show the date picker on the right click menu
Global fShowDPInGrid As Boolean 'flag if we show the date picker in the grid
Global highlightDate As Date 'check for cell to highlight in calendar
Global highlightPicker As Integer 'special value to highlight in the "my" picker
Global g_gridDP As Shape 'dp entry point for grid
Global pickerMode As Integer '0=normal, 1=months, 2=years
Global pickerYearsOffset As Integer 'tracks how far off of cYear to show in the years picker

'gets the month and year and populates the date picker
Sub populateDatePickerDays()
    Dim i As Integer: Dim j As Integer
    
    Dim the_startOfMonth As Date 'date object that is the start of the current month
    Dim trackingDate As Date 'the top left position of the calendar control, then incremented as we fill out the calendar
    Dim iStartOfMonthDay As Integer 'day of the week the month starts on
    
    Dim cDayLabel1 As control 'the label control for the day we're editing
    Dim cDayLabelBG1 As control 'the BG label control for the day we're editing
    
    'get the start of the month
    the_startOfMonth = VBA.DateSerial(cYear, cMonth, 1)
    
    'get the day of the week for the start
    iStartOfMonthDay = VBA.Weekday(the_startOfMonth, vbSunday)
    
    'get the top left date for the calendar
    trackingDate = VBA.DateAdd("d", -iStartOfMonthDay + 1, the_startOfMonth)
    
    'set the month label
    datepickerform.monthTitle.Caption = VBA.MonthName(cMonth, True)
    
    'set the year label
    datepickerform.yearTitle.Caption = cYear

    'loop through each week
    For i = 1 To 6
        
        'loop though each day of the week
        For j = 1 To 7
            'get the controls for the day
            Set cDayLabel1 = datepickerform.Controls("day" & i & j)
            Set cDayLabelBG1 = datepickerform.Controls("dayBG" & i & j)
            
            'set the caption for the day
            cDayLabel1.Caption = VBA.day(trackingDate)
            
            'set the tag info for inserting
            cDayLabel1.Tag = trackingDate
            cDayLabelBG1.Tag = trackingDate
            
            'check to see if we should gray the label
            If VBA.Month(trackingDate) <> cMonth Then
                'not current month, fade some
                cDayLabel1.ForeColor = 8421504
            Else
                'current month, make normal
                cDayLabel1.ForeColor = -2147483630
            End If
            
            'check to see if we should highlight the day
            specialHighlight cDayLabelBG1
            
            'move to the next day
            trackingDate = VBA.DateAdd("d", 1, trackingDate)
        Next j
    Next i
    
End Sub

'highlights days in the calendar
Sub specialHighlight(theBGControl As control, Optional picker As Boolean = False)
    
    'check to see if its already flagged and remove it
    '(bug with changing months)
    If theBGControl.BackColor = 12632319 Then
        theBGControl.BackColor = 16777215
    End If
    
    'see if we should highlight it
    If picker Then
        'use highlight picker for the picker control
        If highlightPicker = theBGControl.Tag Then
            theBGControl.BackColor = 12632319
        End If
    Else
        'use highlight date for calendar
        If highlightDate = theBGControl.Tag Then
            theBGControl.BackColor = 12632319
        End If
    End If
    
End Sub

'fills out Sun - Sat captions
Sub populateWeekdayNames()
    Dim i As Integer
    
    For i = 1 To 7
         datepickerform.Controls("dayofweek" & i).Caption = VBA.WeekdayName(i, True, vbSunday)
    Next i
    
End Sub

'shows the date picker
Sub showDatePicker()
    'make sure the manager is loaded
    ensureDPManager

    'flag that picker is visible
    g_oDP.PickerVisible = True

    'setup the special highlight date
    If VBA.IsDate(ActiveCell) Then
        'use the current cells value
        highlightDate = VBA.DateValue(ActiveCell)
    Else
        'use today
        highlightDate = VBA.Date
    End If
    
    'set the global month and year
    cMonth = VBA.Month(highlightDate)
    cYear = VBA.Year(highlightDate)
    
    'show the calendar form
    datepickerform.Show
    
    'be sure the form moves to position
    MoveFormToMouse datepickerform
    
    'hook up mousewheel
    DoHookFormScroll datepickerform
End Sub

'closes the date picker
Sub closeDatePicker()
    'ensure DP object
    ensureDPManager

    'check if its visible
    If g_oDP.PickerVisible Then
        'unhook mouse wheel scrolling
        UnhookFormScroll
        
        'get rid of the date picker form
        Unload datepickerform
        
        'update the manager to false
        g_oDP.PickerVisible = False
    End If
End Sub

'user clicked to insert today, do some processing before handing off to day picked
Sub nowPicked(id As Integer, Button As Integer)
    If Button > 1 Then
        'right click or something else, include time
        dayPicked 68, True
    Else
        'left click, just the date
        dayPicked 68
    End If
End Sub

'called by the buttons on the date picked when clicked
Sub dayPicked(id As Integer, Optional inculdeTime As Boolean = False)
    If id <= 67 Then
        'get the tag info for the control
        datePicked = datepickerform.Controls("day" & id).Tag
    ElseIf id = 68 Then
        'get the date and time for now
        datePicked = VBA.Date
        
        'see if we add time
        If inculdeTime Then datePicked = datePicked & " " & VBA.Time
    End If
    
    'insert the date to the cell(s)
    DoAction Date_Picker, True
    
    'close the date picker
    closeDatePicker
End Sub

'called by the button on the "my" picker when clicked
Sub pickerClicked(id As Integer)

    'check mode
    If pickerMode = 1 Then
        'update month value
        cMonth = datepickerform.Controls("my" & id).Tag
    ElseIf pickerMode = 2 Then
        'update year value
        cYear = datepickerform.Controls("my" & id).Tag
    End If
    
    'reload
    populateDatePickerDays
    
    'close picker
    setPickerMode 0
End Sub

'destroys the grid entry point
Sub killGridDP()
    On Error Resume Next
    
    'delete it
    g_gridDP.Delete
    
    'make sure its set to nothing
    Set g_gridDP = Nothing
    
    On Error GoTo 0
End Sub

'makes the grid entry point and places it
Sub createGridDP()
    
    On Error GoTo create_err
    
    'be sure the current one is deleted
    If Not (g_gridDP Is Nothing) Then
        killGridDP
    End If
    
    'create a new one
    Set g_gridDP = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left + ActiveCell.Width + 6, ActiveCell.Top, 16, 16)
    
    'add image
    With g_gridDP.Fill
        .Visible = msoTrue
        .UserPicture pathToIcon
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
    
    'format the border away
    g_gridDP.Line.Visible = msoFalse
    
    'add click event
    g_gridDP.OnAction = "'" & ThisWorkbook.Name & "'!dp_core.gridDP_Click"
    
create_err:
End Sub

'user clicked on the gridDP entry
Public Sub gridDP_Click() ' #visible
    showDatePicker
End Sub

'toggles the month picker
Sub toggleMonthPicker()
    If pickerMode = 1 Then
        setPickerMode 0
    Else
        setPickerMode 1
        showPicker
    End If
End Sub

'toggles the year picker
Sub toggleYearPicker()
    If pickerMode = 2 Then
        setPickerMode 0
    Else
        setPickerMode 2
        showPicker
    End If
End Sub

'shows the my picker
Sub showPicker()
    datepickerform.Controls("myFrame").Top = 30
End Sub

'hides the my picker
Sub hidePicker()
    datepickerform.Controls("myFrame").Top = datepickerform.Height + 20
End Sub

'set the mode for the picker, and updates the UI
Sub setPickerMode(mode As Integer)
    If mode = 0 Then
        'hide the picker
        pickerMode = 0
        hidePicker
        
        'show buttons
        showPrevNextMonthButtons
    ElseIf mode = 1 Then
        'populate months
        populatePickerMonths
        
        'hide buttons
        hidePrevNextMonthButtons
        
        'set the flag to months
        pickerMode = 1
    ElseIf mode = 2 Then
        'reset offset for year scrolling
        pickerYearsOffset = -6
        
        'populate years
        populatePickerYears
        
        'show buttons
        showPrevNextMonthButtons
        
        'set the flag
        pickerMode = 2
    End If
End Sub

'updates the "my" picker strings to months
Sub populatePickerMonths()
    Dim i As Integer

    'ref to the control to update
    Dim myControl As control
    Dim myBGControl As control
    
    'loop through and populate the months
    For i = 1 To 12
        'get a ref to the control to update
        Set myControl = datepickerform.Controls("my" & i)
        Set myBGControl = datepickerform.Controls("mybg" & i)
        
        'set the string
        myControl.Caption = VBA.MonthName(i, True)
        
        'set the tag to the value we'll act on later
        myControl.Tag = i
        myBGControl.Tag = i
        
        'clear any highlight
        myBGControl.BackColor = 16777215
        
        'see if we should highlight
        specialHighlight myBGControl, True
    Next i
End Sub

Sub populatePickerYears()
    Dim i As Integer

    'ref to the control to update
    Dim myControl As control
    Dim myBGControl As control
    Dim loopStart As Integer
    
    loopStart = cYear + pickerYearsOffset
    
    'loop through and populate the months
    For i = 1 To 12
        'get a ref to the control to update
        Set myControl = datepickerform.Controls("my" & i)
        Set myBGControl = datepickerform.Controls("mybg" & i)
        
        'set the string
        myControl.Caption = loopStart
        
        'set the tag to the value we'll act on later
        myControl.Tag = loopStart
        myBGControl.Tag = loopStart
        
        'clear any highlight
        myBGControl.BackColor = 16777215
        
        'see if we should highlight
        specialHighlight myBGControl, True
        
        'inc the year
        loopStart = loopStart + 1
    Next i
End Sub

'hides/shows the buttons when they don't apply (for month picker)
Sub hidePrevNextMonthButtons()
    datepickerform.Controls("prevMonthButton").Visible = False
    datepickerform.Controls("nextMonthButton").Visible = False
End Sub
Sub showPrevNextMonthButtons()
    datepickerform.Controls("prevMonthButton").Visible = True
    datepickerform.Controls("nextMonthButton").Visible = True
End Sub