Attribute VB_Name = "modSubclass"
Option Explicit

Public Declare Function CallWindowProc Lib "user32" 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC = -4

Private Const WM_MOUSEMOVE = &H200
Private Const WM_MOUSELEAVE = &H2A3

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type HDHITTESTINFO
    pt As POINTAPI
    flags As Long
    iItem As Long
End Type
Private Const HDM_FIRST = &H1200
Private Const HDM_HITTEST = HDM_FIRST + 6
Private Const HDM_GETITEMA = (HDM_FIRST + 3)
Private Const HDM_GETITEM = HDM_GETITEMA

Private Type HD_ITEM
    mask As Long
    cxy As Long
    pszText As String
    hbm As Long
    cchTextMax As Long
    fmt As Long
    lParam As Long
    ' 4.70:
    iImage As Long
    iOrder As Long
End Type
Private Const HDI_LPARAM = &H8

Private Type TLoHiLong
   Lo As Integer
   Hi As Integer
End Type
Private Type TAllLong
   All As Long
End Type
Dim mLH As TLoHiLong, mAL As TAllLong


Private m_lPrevWndProc As Long
Private m_lCurHdrItem As Long

Public Sub Hook(ByVal pHwnd As Long)
   m_lPrevWndProc = SetWindowLong(pHwnd, GWL_WNDPROC, AddressOf WindowProc)
   m_lCurHdrItem = -1
End Sub

Public Sub Unhook(ByVal pHwnd As Long)
   SetWindowLong pHwnd, GWL_WNDPROC, m_lPrevWndProc
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long
   
   Const cSpacer = " "
   Const cPart = ":"
   Const cQEKeys = ";[Num 1..6];;;[Num +/-];;[`];[1];[2];[3];[4];[5];[6];[7];[8];[9];[0];[-];[=];[BkSpc]"
   
   Dim hti As HDHITTESTINFO
   Dim lCol As Long
   
   Select Case uMsg
   Case WM_MOUSEMOVE
      ' The low and high words of lParam contains x and y coordinates
      ' of the mouse pointer respectively:
      mAL.All = lParam
      LSet mLH = mAL
      hti.pt.X = mLH.Lo
      hti.pt.Y = mLH.Hi
      ' retrieving the index of the header item under the mouse pointer:
      SendMessage hwnd, HDM_HITTEST, 0&, hti
      ' if the current header changed...
      
      If hti.iItem <> m_lCurHdrItem Then
         m_lCurHdrItem = hti.iItem
         
        Select Case hwnd
        Case mlvwTeams_HdrHwnd:
            With frmTeams
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwTeams.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwTeams.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmTeams.TT.TipText = .Text
                        Else
                            frmTeams.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    .TT.Create hwnd
                End If
            End With
        
        Case mlvwGoalies_HdrHwnd:
            With frmGoalies
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwGoalies.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwGoalies.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmGoalies.TT.TipText = .Text
                        Else
                            frmGoalies.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    If blnmnuToolsQuickEditKeysOn Then
                        If (blnROMPlayerPositionSupport And m_lCurHdrItem = 1) Or (m_lCurHdrItem > 1) Then
                            .TT.TipText = RTrim(.TT.TipText & cSpacer & Split(cQEKeys, ";")(m_lCurHdrItem))
                        End If
                    End If
                    .TT.Create hwnd
                End If
            End With
        
        Case mlvwPlayers_HdrHwnd:
            With frmPlayers
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwPlayers.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwPlayers.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmPlayers.TT.TipText = .Text
                        Else
                            frmPlayers.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    If blnmnuToolsQuickEditKeysOn Then
                        'Debug.Print m_lCurHdrItem
                        If (blnROMPlayerPositionSupport And m_lCurHdrItem = 1) Or (m_lCurHdrItem > 1) Then
                            .TT.TipText = RTrim(.TT.TipText & cSpacer & Split(cQEKeys, ";")(m_lCurHdrItem))
                        End If
                    End If
                    .TT.Create hwnd
                End If
            End With
        
        Case mlvwLines_HdrHwnd:
            With frmLines
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwLines.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwLines.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmLines.TT.TipText = .Text
                        Else
                            frmLines.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    .TT.Create hwnd
                End If
            End With
        
        Case mlvwPlayoffDraws_HdrHwnd:
            With frmPlayoffDraws
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwPlayoffDraws.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwPlayoffDraws.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmPlayoffDraws.TT.TipText = .Text
                        Else
                            frmPlayoffDraws.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    .TT.Create hwnd
                End If
            End With
        
        'Case mlvwTimers_HdrHwnd:
        '    With frmTimers
        '        .TT.Destroy
        '        If m_lCurHdrItem <> -1 Then
        '            '.TT.Title = .lvwPeriodLengths.ColumnHeaders(m_lCurHdrItem + 1).Text
        '            With .lvwTimers.ColumnHeaders(m_lCurHdrItem + 1)
        '                If .Text = .Tag Then
        '                    frmTimers.TT.TipText = .Text
        '                Else
        '                    frmTimers.TT.TipText = .Text & cPart & cSpacer & .Tag
        '                End If
        '            End With
        '            .TT.Create hwnd
        '        End If
        '    End With
        
        Case mlvwRules_HdrHwnd:
            With frmRules
                'Debug.Print "Rules!"
                .TT.Destroy
                If m_lCurHdrItem <> -1 Then
                    '.TT.Title = .lvwRules.ColumnHeaders(m_lCurHdrItem + 1).Text
                    With .lvwRules.ColumnHeaders(m_lCurHdrItem + 1)
                        If .Text = .Tag Then
                            frmRules.TT.TipText = .Text
                        Else
                            frmRules.TT.TipText = .Text & cPart & cSpacer & .Tag
                        End If
                    End With
                    .TT.Create hwnd
                End If
            End With

        End Select
        
      End If
   
   Case WM_MOUSELEAVE
        m_lCurHdrItem = -1
        Select Case hwnd
            Case mlvwTeams_HdrHwnd:
                frmTeams.TT.Destroy
            Case mlvwGoalies_HdrHwnd:
                frmGoalies.TT.Destroy
            Case mlvwPlayers_HdrHwnd:
                frmPlayers.TT.Destroy
            Case mlvwLines_HdrHwnd:
                frmLines.TT.Destroy
            Case mlvwPlayoffDraws_HdrHwnd:
                frmPlayoffDraws.TT.Destroy
            'Case mlvwTimers_HdrHwnd:
            '    frmTimers.TT.Destroy
        End Select
   End Select
   
   WindowProc = CallWindowProc(m_lPrevWndProc, hwnd, uMsg, wParam, lParam)
End Function


