Re: Question on ListView

• • Reply

  14 years ago

  by DoctorMahdi

  DoctorMahdi

  , Somalia

  Joined 15 years ago

  Hi apol

  Here is the code from the second link:

  '====bas module code=====
   
  Option Explicit
  
    Public Const NM_CUSTOMDRAW = (-12&)
    Public Const WM_NOTIFY As Long = &H4E&
   
    Public Const CDDS_PREPAINT As Long = &H1&
    Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
    Public Const CDDS_ITEM As Long = &H10000
    Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
    Public Const CDRF_NEWFONT As Long = &H2&
   
    Public Type NMHDR
      hWndFrom As Long   ' Window handle of control sending message
      idFrom As Long        ' Identifier of control sending message
      code  As Long          ' Specifies the notification code
    End Type
   
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
    ' sub struct of the NMCUSTOMDRAW struct
  
    Public Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
    End Type
   
   
  
  
  
  
  
  
  ' generic customdraw struct
    Public Type NMCUSTOMDRAW
      hdr As NMHDR
      dwDrawStage As Long
      hDC As Long
      rc As RECT
      dwItemSpec As Long
      uItemState As Long
      lItemlParam As Long
    End Type
   
   
  
  
  
  
  
  
  
  
  
  
  ' listview specific customdraw struct
    Public Type NMLVCUSTOMDRAW
      nmcd As NMCUSTOMDRAW
      clrText As Long
      clrTextBk As Long
     
  
  
  
  
  ' if IE >= 4.0 this member of the struct can be used
  
      'iSubItem As Integer
    End Type
  
    Public g_addProcOld As Long
    Public g_MaxItems As Long
     
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
    Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
   
  Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case iMsg
      Case WM_NOTIFY
        Dim udtNMHDR As NMHDR
        CopyMemory udtNMHDR, ByVal lParam, 12&
        With udtNMHDR
          If .code = NM_CUSTOMDRAW Then
            Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
            CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
            With udtNMLVCUSTOMDRAW.nmcd
              Select Case .dwDrawStage
                Case CDDS_PREPAINT
                  WindowProc = CDRF_NOTIFYITEMDRAW
                  Exit Function
                Case CDDS_ITEMPREPAINT
                    If Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Index) = 3 Then
                       udtNMLVCUSTOMDRAW.clrText = vbRed
                    Else
                       udtNMLVCUSTOMDRAW.clrText = vbBlack
                    End If
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  'You may also change BackColor same way:
  '                 udtNMLVCUSTOMDRAW.clrTextBk = Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Tag)
                    CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                    WindowProc = CDRF_NEWFONT
                    Exit Function
              End Select
            End With
          End If
        End With
    End Select
    WindowProc = CallWindowProc(g_addProcOld, hwnd, iMsg, wParam, lParam)
  End Function
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  '=======Form code=======
  
  Option Explicit
  Private Const GWL_WNDPROC As Long = (-4&)
  Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
  
  Private Sub Form_Load()
    With ListView1
      .FullRowSelect = True
      .ColumnHeaders.Add , , "Item Column"
      .ColumnHeaders.Add , , "Subitem 1"
      .ColumnHeaders.Add , , "Subitem 2"
      Dim i&
      For i = 1 To 30
        With .ListItems.Add(, , CStr(Int(200 * Rnd)))
          .SubItems(1) = "Subitem 1"
          .SubItems(2) = "Subitem 2"
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  'I used Tag property to set back color
          .Tag = CStr(QBColor(i Mod 15))
        End With
      Next
     
  
  
  
  .ListItems(20).ForeColor = vbBlue
  
      g_MaxItems = .ListItems.Count - 1
    End With
    g_addProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
  End Sub
  
  Private Sub Form_Unload(Cancel As Integer)
    Call SetWindowLong(hwnd, GWL_WNDPROC, g_addProcOld)
  End Sub
  
  
  
  
  
  
  
  
  'Note: This code use subclassing. So, don't stop it from IDE stop button, use form [x] button instead
  
  

  This code is not tested; remove the red line from the code it's only for test

  Regards

  DoctorMahdi

   

   

  Report abuse