Windows Analysis Report
samradapps_datepicker.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
Private WithEvents OILldOdoldiIoldIiiOIOilol As Application
Attribute OILldOdoldiIoldIiiOIOilol.VB_VarHelpID = -1
Private dOoolIOiOOddiloiodiOiLoLo As Boolean
Private Sub Class_Initialize()
    On Error Resume Next
    Set OILldOdoldiIoldIiiOIOilol = Application
    dOoolIOiOOddiloiodiOiLoLo = False
    On Error GoTo 0
End Sub
Private Sub Class_Terminate()
    iiloOddILoIdLiIiLlLdioLol
End Sub
Public Property Get PickerVisible() As Variant
    PickerVisible = dOoolIOiOOddiloiodiOiLoLo
End Property
Public Property Let PickerVisible(ByVal vNewValue As Variant)
    dOoolIOiOOddiloiodiOiLoLo = vNewValue
End Property
Private Sub OllLoLoLdIoooLILlOoOOidid()
    iiloOddILoIdLiIiLlLdioLol
    iliOdiOLollIdiOddLIIIiLlO
End Sub
Private Sub oiioOoOLIloOlOOIOiidOOdLL()
    OllLoLoLdIoooLILlOoOOidid
End Sub
Private Sub iiloOddILoIdLiIiLlLdioLol()
    LOIloOILiLoLodOLLOLodoiLL
    iIlOIiillIoLIliIoddolooOI
End Sub
Private Sub iliOdiOLollIdiOddLIIIiLlO()
    iiloOddILoIdLiIiLlLdioLol
    If oOlLdOOiIiidIdOIodLOdooil Then
        loIllollIlOIdiIIioOOOoLIi
    End If
End Sub
Private Function oOlLdOOiIiidIdOIodLOdooil() As Boolean
    On Error GoTo check_err
    Dim cellAbove As Range
    oOlLdOOiIiidIdOIodLOdooil = False
    If (fShowDPInGrid) Then
        If TypeName(ActiveCell) = "Range" Then
            If VBA.IsDate(ActiveCell) Then
                oOlLdOOiIiidIdOIodLOdooil = True
            Else
                If ActiveCell <> "" Then Exit Function
                If ActiveCell.Row <> 1 Then
                    Set cellAbove = ActiveCell.Offset(-1, 0)
                    If InStr(1, cellAbove, "date", vbTextCompare) > 0 Or VBA.IsDate(cellAbove) Then
                        oOlLdOOiIiidIdOIodLOdooil = True
                    End If
                End If
            End If
        End If
    End If
check_err:
End Function
Private Sub OILldOdoldiIoldIiiOIOilol_SheetSelectionChange(ByVal Sh As Object, ByVal OlIIIldddIidooLoiOOlddIdO As Range)
    OllLoLoLdIoooLILlOoOOidid
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_NewWorkbook(ByVal Wb As Workbook)
    oiioOoOLIloOlOOIOiidOOdLL
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    iiloOddILoIdLiIiLlLdioLol
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    iiloOddILoIdLiIiLlLdioLol
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
    LOIloOILiLoLodOLLOLodoiLL
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_SheetActivate(ByVal Sh As Object)
    OllLoLoLdIoooLILlOoOOidid
End Sub
Private Sub OILldOdoldiIoldIiiOIOilol_WorkbookActivate(ByVal Wb As Workbook)
    oiioOoOLIloOlOOIOiidOOdLL
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 = "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
Private Sub Workbook_Open()
    IoOdiIlIOidLOldlIiOLoOliL
    dlOLOlllOLollIioOilOOlLld
End Sub

Attribute VB_Name = "api_caption_timer"
#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 tCursor) 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 OdiooIdLloiOooOLLidlddddd 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 tCursor) 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 OdiooIdLloiOooOLLidlddddd As Long
    Dim hdc As Long
    Dim mhWndForm As Long
#End If
Const liOIIiLllOoLoOdOlIooliOld = 88
Const oOOoidoLiodLoLliiIlIILLOi = 90
Public Type tCursor
    Left As Long
    Top As Long
End Type
Dim OdOLililiddlLdiOldOdIoioO As Single, tim As Boolean, Counter As Long
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 OOOILloOiloOlliOLoOOioddi As Long
Public g_screenWidth As Long
Sub LOLLOLLOLLooILiIiloOiOlll(objForm As Object)
    Dim lStyle          As Long
    Dim hMenu           As Long
    If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", objForm.Caption)
    Else
mhWndForm = FindWindow("ThunderDFrame", objForm.Caption)
    End If
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
End Sub
Private Function oOlIlOoiOLIdLooLioIOLILll() As Double
    hdc = GetDC(0)
    oOlIlOoiOLIdLooLioIOLILll = 72 / GetDeviceCaps(hdc, liOIIiLllOoLoOdOlIooliOld)
    ReleaseDC 0, hdc
End Function
Private Function odlIiOLLLloIoIoIIILOoLoio() As Double
    hdc = GetDC(0)
    odlIiOLLLloIoIoIIILOoLoio = 72 / GetDeviceCaps(hdc, oOOoidoLiodLoLliiIlIILLOi)
    ReleaseDC 0, hdc
End Function
Private Function OdlLOLioiildLdLOolIdIiLdO() As tCursor
    Dim mPos As tCursor
    GetCursorPos mPos
    OdlLOLioiildLdLOolIdIiLdO = mPos
End Function
Private Function dLdLiLilIdoIdLoolLooOoOiI() As tCursor
    Dim mPos As tCursor
    mPos = OdlLOLioiildLdLOolIdIiLdO
    mPos.Left = odlIiOLLLloIoIoIIILOoLoio * mPos.Left
    mPos.Top = oOlIlOoiOLIdLooLioIOLILll * mPos.Top
    dLdLiLilIdoIdLoolLooOoOiI = mPos
End Function
Sub StartTimer()
    OdOLililiddlLdiOldOdIoioO = 1
    OdiooIdLloiOooOLLidlddddd = SetTimer(0&, 0&, OdOLililiddlLdiOldOdIoioO * 1000&, AddressOf LLiIdliollIdiioOOOOLoIOLO)
End Sub
Sub OILOLOdlOOIdIddOdLiddOIdi()
    On Error Resume Next
    KillTimer 0&, OdiooIdLloiOooOLLidlddddd
End Sub
Sub LLiIdliollIdiioOOOOLoIOLO(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    If OIddlldldlIdILOdoIlOldodI("datepickerform") Then
        datepickerform.timeButton.Caption = VBA.Time
    Else
        OILOLOdlOOIdIddOdLiddOIdi
    End If
End Sub
Private Function OIddlldldlIdILOdoIlOldodI(ByVal UFName As String) As Boolean
    Dim iILoOLoolLiOOlIoiOOLddIio As Object
    For Each iILoOLoolLiOOlIoiOOLddIio In VBA.UserForms
        OIddlldldlIdILOdoIlOldodI = iILoOLoolLiOOlIoiOOLddIio.Name = UFName
        If OIddlldldlIdILOdoIlOldodI Then
            Exit For
        End If
    Next
End Function
Public Sub IldiILOdoooIIildIOOOLIloo()
    OOOILloOiloOlliOLoOOioddi = GetSystemMetrics32(SM_CYMAXIMIZED)
    OOOILloOiloOlliOLoOOioddi = OOOILloOiloOlliOLoOOioddi * odlIiOLLLloIoIoIIILOoLoio
    g_screenWidth = GetSystemMetrics32(SM_CXMAXIMIZED)
    g_screenWidth = g_screenWidth * oOlIlOoiOLIdLooLioIOLILll
    OOOILloOiloOlliOLoOOioddi = OOOILloOiloOlliOLoOOioddi - 20
    g_screenWidth = g_screenWidth - 20
    If OOOILloOiloOlliOLoOOioddi < 300 Then OOOILloOiloOlliOLoOOioddi = 300
    If g_screenWidth < 300 Then g_screenWidth = 300
End Sub
Sub LlIIlIIOIILiddLililLlIIdI(oOoOllOioLlddoOiIlOdIloIi)
    Dim OiildOILlIllLddolioioiOLl As tCursor
    OiildOILlIllLddolioioiOLl = dLdLiLilIdoIdLoolLooOoOiI()
    oOoOllOioLlddoOiIlOdIloIi.Top = OiildOILlIllLddolioioiOLl.Top
    oOoOllOioLlddoOiIlOdIloIi.Left = OiildOILlIllLddolioioiOLl.Left
    If OOOILloOiloOlliOLoOOioddi > 0 Then
        If (oOoOllOioLlddoOiIlOdIloIi.Top + oOoOllOioLlddoOiIlOdIloIi.Height) > OOOILloOiloOlliOLoOOioddi Then oOoOllOioLlddoOiIlOdIloIi.Top = OOOILloOiloOlliOLoOOioddi - oOoOllOioLlddoOiIlOdIloIi.Height
    End If
    If g_screenWidth > 0 Then
        If (oOoOllOioLlddoOiIlOdIloIi.Left + oOoOllOioLlddoOiIlOdIloIi.Width) > g_screenWidth Then oOoOllOioLlddoOiIlOdIloIi.Left = g_screenWidth - oOoOllOioLlddoOiIlOdIloIi.Width
    End If
End Sub

Attribute VB_Name = "api_scroll_wheel"
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 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 mFormHwnd                  As Long
Private mbHook                     As Boolean
Dim mForm                          As Object
#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
    Private Function ilLlidddOdiOLiOoOOIiOLiiO(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
                If wParam = WM_MOUSEWHEEL Then
                    ilLlidddOdiOLiOoOOIiOLiiO = True
                    If lParam.hwnd > 0 Then
                        datepickerform.prevMonthButton_Click
                    Else
                        datepickerform.nextMonthButton_Click
                    End If
                    Exit Function
                End If
            End If
        End If
        ilLlidddOdiOLiOoOOIiOLiiO = CallNextHookEx(mLngMouseHook, ncode, wParam, ByVal lParam)
        Exit Function
errH:
        diOoilLOLOILIdodlIlOdloid
    End Function
    Sub IoiLdiiildOLiIiIdIILdLiIo(oForm As Object)
    End Sub
    Sub diOoilLOLOILIdodlIlOdloid()
    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
    Private Function ilLlidddOdiOLiOoOOIiOLiiO(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
                If wParam = WM_MOUSEWHEEL Then
                    ilLlidddOdiOLiOoOOIiOLiiO = True
                    If lParam.hwnd > 0 Then
                        datepickerform.prevMonthButton_Click
                    Else
                        datepickerform.nextMonthButton_Click
                    End If
                    Exit Function
                End If
            End If
        End If
        ilLlidddOdiOLiOoOOIiOLiiO = CallNextHookEx(mLngMouseHook, ncode, wParam, ByVal lParam)
        Exit Function
errH:
        diOoilLOLOILIdodlIlOdloid
    End Function
    Sub IoiLdiiildOLiIiIdIILdLiIo(oForm As Object)
        Dim lngAppInst                  As Long
        Dim hwndUnderCursor             As Long
        Set mForm = oForm
        hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
        If mFormHwnd <> hwndUnderCursor Then
            diOoilLOLOILIdodlIlOdloid
            mFormHwnd = hwndUnderCursor
            lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
            If Not mbHook Then
                mLngMouseHook = SetWindowsHookEx(                 WH_MOUSE_LL, AddressOf ilLlidddOdiOLiOoOOIiOLiiO, lngAppInst, 0)
                mbHook = mLngMouseHook <> 0
            End If
        End If
    End Sub
    Sub diOoilLOLOILIdodlIlOdloid()
        If mbHook Then
            UnhookWindowsHookEx mLngMouseHook
            mLngMouseHook = 0
            mFormHwnd = 0
            mbHook = False
        End If
    End Sub
#End If