Option Explicit
 
Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type
 
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETSUBITEMRECT  As Long = (LVM_FIRST + 56)
Private Const LVIR_LABEL  As Long = 2
 
Private Const WM_NOTIFY  As Long = &H4E
Private Const WM_HSCROLL As Long = &H114
Private Const WM_VSCROLL As Long = &H115
Private Const WM_KEYDOWN As Long = &H100
 
Private Const HDN_FIRST      As Long = (0 - 300)
Private Const HDN_ENDTRACK   As Long = (HDN_FIRST - 1)
 
Private Declare Function SendMessageA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Declare Function SetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private lpPrevWndProc As Long
 
Private Function ListView_GetSubItemRect(ByVal hWndLV As Long, ByVal iItem As Long, ByVal iSubItem As Long, ByVal code As Long, lpRect As RECT) As Boolean
    lpRect.Top = iSubItem
    lpRect.Left = code
    ListView_GetSubItemRect = SendMessageA(hWndLV, LVM_GETSUBITEMRECT, ByVal iItem, lpRect)
End Function
 
Public Sub PutProgressBarInListView(ListView As ListView, InColumn As Long)
    Dim i As Long
 
    For i = 0 To ListView.ListItems.Count - 1
        If i > Form1.ProgressBar1.Count - 1 Then: Call Load(Form1.ProgressBar1(i))
        Call SetParent(Form1.ProgressBar1(i).hWnd, ListView.hWnd)
    Next
 
    Call AdjustProgressBar(ListView, InColumn)
    lpPrevWndProc = SetWindowLongA(ListView.hWnd, -4, AddressOf ListViewProc)
End Sub
 
Public Sub AdjustProgressBar(ListView As ListView, InColumn As Long)
    Dim Pos    As RECT
    Dim i      As Long
 
    For i = 0 To Form1.ProgressBar1.Count - 1
        Call ListView_GetSubItemRect(ListView.hWnd, i, InColumn, LVIR_LABEL, Pos)
        With Form1.ProgressBar1(i)
            .Left = (Pos.Left) * Screen.TwipsPerPixelX
            .Width = (Pos.Right - Pos.Left) * Screen.TwipsPerPixelX
            .Height = ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY)
            .Top = Pos.Top * Screen.TwipsPerPixelY + ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY - .Height) / 2
 
            Call IIf(Pos.Top <= 3, .Visible = False, .Visible = True)
        End With
    Next
End Sub
 
Private Function ListViewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Param       As Long
    Dim bAdjust     As Boolean
 
    Select Case Msg
        Case WM_HSCROLL, WM_VSCROLL: bAdjust = True
        Case WM_KEYDOWN
            Select Case wParam
                Case 33 To 40: bAdjust = True
            End Select
        Case WM_NOTIFY
            Call CopyMemory(Param, ByVal lParam + 8, 4)
            If Param = HDN_ENDTRACK Then: bAdjust = True
    End Select
 
    If bAdjust = True Then: Call AdjustProgressBar(Form1.ListView1, 1)
    ListViewProc = CallWindowProcA(lpPrevWndProc, hWnd, Msg, wParam, lParam)
End Function