Results 1 to 3 of 3

Thread: change color from listview

  1. #1

    Thread Starter
    Fanatic Member mutley's Avatar
    Join Date
    Apr 2000
    Location
    Sao Paulo - Brazil
    Posts
    707

    Question

    Hi

    How I change color of the line listview ?

    Is possible change the background color only of the a line ?


    thank you in advance

  2. #2
    _______ HeSaidJoe's Avatar
    Join Date
    Jun 1999
    Location
    Canada
    Posts
    3,946

    <?>

    Code:
    ' bas module code
    ' hook system and color the backcolor of rows different colors
    ' as with hooking if you unload using the stop button of Visual Basic
    ' and you don't use the unloadquerry (the X on the form)
    ' then windows will crash 
    '
      Option Explicit
      
        Public Const GWL_EXSTYLE = -20
        Public Const GWL_HINSTANCE = -6
        Public Const GWL_HWNDPARENT = -8
        Public Const GWL_ID = -12
        Public Const GWL_STYLE = -16
        Public Const GWL_USERDATA = -21
        Public Const GWL_WNDPROC = -4
        Public Const DWL_DLGPROC = 4
        Public Const DWL_MSGRESULT = 0
        Public Const DWL_USER = 8
    
        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 clr() As Long
    
    
    Public Declare Function SetWindowLong Lib "user32.dll" Alias _
    "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    
      
     Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
      (Destination As Any, Source As Any, ByVal Length As Long)
      
     Public Declare Function CallWindowProc Lib "user32.dll" Alias _
      "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
      ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
      ByVal lParam As Long) As Long
       
    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 clr(.dwItemSpec) <> 0 Then
    'change the color of the text display if wanted
    'udtNMLVCUSTOMDRAW.clrText = vbBlue
                   udtNMLVCUSTOMDRAW.clrTextBk = clr(.dwItemSpec)
                   CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
           End If
               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
    
    Public Sub SetLIBackColor(lv As ListView, nitem As Integer, BkColor As Long)
       clr(nitem - 1) = BkColor
       lv.Refresh
    End Sub
    
    Public Sub SetLIForeColor(lv As ListView, ForeColor As Long)
       clr(nitem - 1) = ForeColor
       lv.Refresh
    End Sub
    
    '<<<<<<<<<<<<<<<<<<<<<<<<<<   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    '
    'Form Code.
    
    Option Explicit
    
    Private Sub Form_Load()
    
      ListView1.FullRowSelect = True
      ListView1.View = lvwReport
      
      With ListView1
        .ColumnHeaders.Add , , "Item Column"
        .ColumnHeaders.Add , , "Subitem 1"
        .ColumnHeaders.Add , , "Subitem 2"
        Dim i&
        For i = 1 To 30
          With .ListItems.Add(, , "Item " & CStr(i))
            .SubItems(1) = "Subitem 1"
            .SubItems(2) = "Subitem 2"
          End With
        Next
      End With
      
    ' Don't forget to redim array if you add/remove listview items
      ReDim Preserve clr(ListView1.ListItems.Count)
      g_MaxItems = ListView1.ListItems.Count - 1
      g_addProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
     
      
    End Sub
    
    Private Sub Command1_Click()
    'set the rows to different colors
      SetLIBackColor ListView1, 1, vbYellow
      SetLIBackColor ListView1, 2, vbRed
      SetLIBackColor ListView1, 3, vbMagenta
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
    
      Call SetWindowLong(hWnd, GWL_WNDPROC, g_addProcOld)
    End Sub
    "A myth is not the succession of individual images,
    but an integerated meaningful entity,
    reflecting a distinct aspect of the real world."

    ___ Adolf Jensen

  3. #3

    Thread Starter
    Fanatic Member mutley's Avatar
    Join Date
    Apr 2000
    Location
    Sao Paulo - Brazil
    Posts
    707

    Talking thanks

    very many thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width