mProgressBarInListView:
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 ;)
Funciona :P
Igual tenias este enlace ListViewProgress By LeandroA (http://www.leandroascierto.com.ar/categoria/M%C3%B3dulos/articulo/ListViewProgress.php)
:P
Good work :), for my part i use a non-native LV which can includes directly native progressbar lol