Código
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
Simplemente necesitaba hacer esto y lo comparto, espero que le sirva a alguien