Attribute VB_Name = "mTaskBarForm"
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Módulo Ordenação por colocar o fTray no taskbar
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do módulo
Private Const ST_MY_NAME As String = "mTaskBarForm"

' API's externas
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

' Constantes
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

' Variáveis
Private rectLastTray As RECT
Private rectLastRebar As RECT
Private rectLastNotify As RECT
Private rectTray As RECT
Private rectTrayClient As RECT
Private rectRebar As RECT
Private rectNotify As RECT

Private hwndForm As Long
Private hwndTray As Long
Private hwndReBr As Long
Private hwndNofy As Long

Private lngTimer As Long
Private intWidth As Integer
Private intLastWidth As Integer
Private intNewWidth As Integer
Private intHeight As Integer
Private intLastHeight As Integer
Private intNewHeight As Integer
Private blnGrow As Boolean
Private X As Long
Private Y As Long
Private W As Long
Private H As Long
Private blCanUpdate As Boolean


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Procedimentos para colocar um form no tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub AttachForm(MyForm As Form, Optional intForceWidth As Integer = 0, Optional intForceHeight As Integer = 0, Optional blnGrowWithTray As Boolean = False, Optional Atach As Boolean = True)
    On Error GoTo ErrTreat:
    
    ' Guarda o hwnd para referências futuras
    hwndForm = MyForm.hWnd
    
    ' Recupera tray atual
    hwndTray = GetTrayHandle
    
    ' Se encontrou
    If (hwndTray <> LN_NO_ADDRESS) Then
    
        ' Recupera handlers restantes
        hwndReBr = GetRebarHandle
        hwndNofy = GetNotifyHandle
        
        ' Seta qual será o width no tray
        If intForceWidth <> 0 Then
            intWidth = intForceWidth
        Else
            intWidth = MyForm.Width
        End If
        intNewWidth = intWidth
        
        ' Seta qual será o height no tray
        If intForceHeight <> 0 Then
            intHeight = intForceHeight
        Else
            intHeight = MyForm.Height
        End If
        intNewHeight = intHeight
        
        ' Seta se o form irá crescer junto ao tray
        blnGrow = blnGrowWithTray
        
        ' Seta o form junto ao Shell_TrayWnd
        If Atach Then
            SetParent hwndForm, hwndTray
        End If
        
        ' Chama função prinicipal
        blCanUpdate = True
        UpdateTaskBar True
    End If
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".AttachForm"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Procedimentos para mudar o tamanho (width) do form no tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ResizeTray(itWidth As Integer, itHeight As Integer)
    On Error Resume Next
    
    ' Verifica se valor é válido e se é diferente do atual
    If (itWidth > 0) And (intNewWidth <> itWidth) Then
        
        ' Seta valor
        intNewWidth = itWidth
    End If
    
    ' Verifica se valor é válido e se é diferente do atual
    If (itHeight > 0) And (intNewHeight <> itHeight) Then
        
        ' Seta valor
        intNewHeight = itHeight
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Procedimentos para liberar do tray temporariamente
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FastFreeForm(Value As Boolean)
    
    ' Se for para liberar o form
    If Value Then
        
        ' Seta para não atualizar
        blCanUpdate = False
        
        ' Retorna o parent do form
        SetParent hwndForm, GetDesktopWindow
    Else
        
        ' Seta o form junto ao Shell_TrayWnd
        SetParent hwndForm, hwndTray
        
        ' Seta que pode atualizar
        blCanUpdate = True
        
        ' Chama a função principal
        UpdateTaskBar True
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Verifica existência do tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function TrayBarExists()
    Dim trayHandle As Long
    On Error GoTo ErrTreat:
    
    ' Recupera tray atual
    trayHandle = GetTrayHandle
    
    ' Se não existir
    If (trayHandle = LN_NO_ADDRESS) Then
        
        ' Reseta atual
        trayHandle = LN_NO_ADDRESS
        
        ' Seta retorno
        TrayBarExists = False
    Else
    
        ' Seta retorno
        TrayBarExists = True
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".TrayBarExists"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Procedimentos para tirar o form do tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub DetachForm()
    Dim trayHandle As Long
    On Error GoTo ErrTreat:
        
    ' Seta que não pode atualizar
    blCanUpdate = False
    
    ' Retorna o parent do form
    SetParent hwndForm, GetDesktopWindow
    
    ' Recupera tray atual
    trayHandle = GetTrayHandle
    
    ' Se igual ao antigo
    If ((trayHandle = hwndTray) And (hwndTray <> LN_NO_ADDRESS)) Then
   
        ' Retorna a estrutura RECT atual (Shell_TrayWnd, ReBarWindow32, TrayNotifyWnd)
        GetWindowRect hwndTray, rectTray
        GetClientRect hwndTray, rectTrayClient
        GetWindowRect hwndReBr, rectRebar
        GetWindowRect hwndNofy, rectNotify

        ' Seta o ReBarWindow32 ao normal
        If (rectTray.Right - rectTray.Left) > (rectTray.Bottom - rectTray.Top) Then   'Horizontal
            X = rectRebar.Left + rectTray.Left              'original starting position
            Y = rectTrayClient.Top                          'always at the top
            W = rectNotify.Left - rectRebar.Left            'align with notify tray
            H = rectRebar.Bottom - rectRebar.Top            'original height
            MoveWindow hwndReBr, X, Y, W, H, 1
            GetWindowRect hwndReBr, rectRebar
        ElseIf (rectTray.Bottom - rectTray.Top) > (rectTray.Right - rectTray.Left) Then
            X = rectTrayClient.Left                         'always at left
            Y = rectRebar.Top + rectTray.Top                'original starting y
            H = rectNotify.Top - rectRebar.Top              'align with notify tray
            W = rectRebar.Right - rectRebar.Left            'original width
            MoveWindow hwndReBr, X, Y, W, H, 1
            GetWindowRect hwndReBr, rectRebar
        End If
    End If
    
    ' Atualiza handler
    hwndTray = trayHandle

    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".DetachForm"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Função que retorna o tamanho do tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetTrayHeigh() As Long
    On Error Resume Next
    Dim rectTray As RECT
    
    ' Pega as dimensões do tray
    rectTray = GetTrayRect
    
    ' Calcula e retorna
    GetTrayHeigh = (rectTray.Bottom - rectTray.Top)
End Function

Public Function GetTrayWidth() As Long
    On Error Resume Next
    Dim rectTray As RECT
    
    ' Pega as dimensões do tray
    rectTray = GetTrayRect
    
    ' Calcula e retorna
    GetTrayWidth = (rectTray.Right - rectTray.Left)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Função que retorna a dimensão do tray
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetTrayRect() As RECT
    On Error Resume Next
    
    ' Se não houver tray
    If (hwndTray = LN_NO_ADDRESS) Then
        
        ' Recupera tray atual
        hwndTray = GetTrayHandle
    End If
    
    ' Retorna dimensões
    GetWindowRect hwndTray, GetTrayRect
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Função que retorna o tipo do trau
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetTrayType() As TASK_TYPE
    On Error Resume Next
    Dim rAux As RECT
    
    ' Pega as dimensões do tray
    rAux = GetTrayRect
    
    ' Verifica se é 'chão'
    If (rAux.Top > 0) Then
        
        ' Retorna
        GetTrayType = ttBottom
    
    ' Verifica se é direita
    ElseIf (rAux.Left > 0) Then
        
        ' Retorna
        GetTrayType = ttRigth
    
    ' Verifica se é cima
    ElseIf (rAux.Bottom < rAux.Right) Then
    
        ' Retorna
        GetTrayType = ttTop
    
    ' Verifica se é esquerda
    ElseIf (rAux.Bottom > rAux.Right) Then
        
        ' Retorna
        GetTrayType = ttLeft
    
    ' Não foi possível definir o tipo
    Else
        
        ' Retorna
        GetTrayType = ttNone
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Procedimento principal
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function UpdateTaskBar(Optional Force As Boolean = False) As Boolean
    On Error GoTo ErrTreat:
    
    ' Verifica se pode atualizar
    If blCanUpdate Then

        ' Retorna a estrutura RECT atual (Shell_TrayWnd, ReBarWindow32, TrayNotifyWnd)
        GetWindowRect hwndTray, rectTray
        GetWindowRect hwndReBr, rectRebar
        GetWindowRect hwndNofy, rectNotify
        
        ' Verifica se houve alguma mudança no tray
        If (rectTray.Top <> rectLastTray.Top) Or (rectRebar.Right <> rectLastRebar.Right) Or (rectNotify.Left <> rectLastNotify.Left) Or (intLastWidth <> intNewWidth) Or (intLastHeight <> intNewHeight) Or Force Then
            
            ' Seta que houve mudanças
            UpdateTaskBar = True
            
            ' Retorna estrutura RECT atual do TrayClient
            GetClientRect hwndTray, rectTrayClient
    
            ' Determinar orientação do tray
            If (rectTray.Right - rectTray.Left) > (rectTray.Bottom - rectTray.Top) Then   'Horizontal
                
                ' Se há diferença significante entre a nova largura e a antiga
                If ((Abs(intNewWidth - intLastWidth)) > 1) Then
                
                    ' Usa metade da nova largura
                    intWidth = intWidth + ((intNewWidth - intLastWidth) / 2)
                Else
                
                    ' Usa nova largura
                    intWidth = intNewWidth
                End If
                
                ' Usa nova altura
                intHeight = intNewHeight
                
                ' Redimensiona o ReBarWindow32 e atualiza sua estrutura
                X = rectRebar.Left + rectTray.Left              'original starting position
                Y = rectTrayClient.Top                          'always at the top
                W = rectNotify.Left - rectRebar.Left - intWidth 'put a buffer between the notify and rebar windows
                H = rectRebar.Bottom - rectRebar.Top            'original height
                MoveWindow hwndReBr, X, Y, W, H, 1
                
                ' Move a tela para a posição reservada do taskbar
                GetWindowRect hwndReBr, rectRebar
                X = rectRebar.Right                             'start at right of rebar
                Y = rectTrayClient.Top + 4                      'give a 4 pixel buffer from top of tray client area
                W = intWidth
                
                ' Se for horizontal, checar se o tamanho especificado é maior que o do prório tray
                If (intNewHeight > (rectTrayClient.Bottom - rectTrayClient.Top - 6)) Or blnGrow = True Then
                    H = rectTrayClient.Bottom - rectTrayClient.Top - 6
                Else
                    H = intNewHeight
                End If
                
                ' Seta a posição do form
                MoveWindow hwndForm, X, Y, W, (H - IT_TRAYBAR_BORDER), 1
            
            ElseIf (rectTray.Bottom - rectTray.Top) > (rectTray.Right - rectTray.Left) Then 'Vertical
                
                ' Se há diferença significante entre a nova altura e a antiga
                If ((Abs(intNewHeight - intLastHeight)) > 1) Then
                
                    ' Usa metade da nova altura
                    intHeight = intHeight + ((intNewHeight - intLastHeight) / 2)
                Else
                
                    ' Usa nova altura
                    intHeight = intNewHeight
                End If
                
                ' Usa nova largura
                intWidth = intNewWidth
                
                ' Redimensiona o ReBarWindow32 e atualiza sua estrutura
                X = rectTrayClient.Left                         'always at left
                Y = rectRebar.Top + rectTray.Top                'original starting y
                H = rectNotify.Top - rectRebar.Top - intHeight  'specified height
                W = rectRebar.Right - rectRebar.Left            'original width
                MoveWindow hwndReBr, X, Y, W, H, 1
                
                ' Move a tela para a posição reservada do taskbar
                GetWindowRect hwndReBr, rectRebar
                X = rectTrayClient.Left + IT_TRAYBAR_BORDER
                Y = rectRebar.Bottom
                H = intHeight                       'specified height
                
                ' Se for horizontal, checar se o tamanho especificado é maior que o do prório tray
                If (intNewWidth > (rectTrayClient.Right - rectTrayClient.Left - 6)) Or blnGrow = True Then
                    W = rectTrayClient.Right - rectTrayClient.Left - 6
                Else
                    W = intNewWidth
                End If
                
                ' Seta a posição do form
                MoveWindow hwndForm, X, Y, W, (H - IT_TRAYBAR_BORDER), 1
            End If
            
            ' Guarda valores para futura comparações
            rectLastTray = rectTray
            rectLastRebar = rectRebar
            rectLastNotify = rectNotify
            intLastWidth = intWidth
            intLastHeight = intHeight
        Else
            
            ' Seta que não houve mudanças
            UpdateTaskBar = False
        End If
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".UpdateTaskBar"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna referência do Shell_TrayWnd
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetTrayHandle() As Long
    On Error Resume Next

    ' Pega e retorna referência
    GetTrayHandle = FindWindow("Shell_TrayWnd", "")
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna referência do ReBarWindow32
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetRebarHandle() As Long
    On Error Resume Next
    
    ' Pega a referência da janela filha e retorna
    GetRebarHandle = FindWindowEx(hwndTray&, 0, "ReBarWindow32", vbNullString)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna referência do TrayNotifyWnd
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetNotifyHandle() As Long
    On Error Resume Next
    
    ' Pega a referência da janela filha e retorna
    GetNotifyHandle = FindWindowEx(hwndTray&, 0, "TrayNotifyWnd", vbNullString)
End Function