[VB6] ProgressBarInListView

[F3B14N]

mProgressBarInListView:

Código (vb) [Seleccionar] Expandir

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

[raul338]

Funciona

Igual tenias este enlace ListViewProgress By LeandroA

[philipjfry99]

Good work , for my part i use a non-native LV which can includes directly native progressbar lol