Listview color

[Neil Hosgood]

It seems that a 6 inch think manual could be written
about the listview control, if anyone knows of one please
let me know

My question is... Is it possible to set the color of a row
in a listview?, ie. make every second row a different color?


TA.

N.

------------------

[Roberto Valois]

Yes

Look at the %NM_CUSTOMDRAW notify message.

'*******************************************************************************

'   GRID.BAS Sample for PB/DLL 6.0
'   2001 RValois Informática

'*******************************************************************************

#Dim All
#Compile Exe

'*******************************************************************************

' Eliminate Unnecessary Macros

'*******************************************************************************

%NOANIMATE       = 1
%NOBUTTON        = 1
%NOCOMBO         = 1
%NODATETIMEPICK  = 1
%NODRAGLIST      = 1
%NOHEADER        = 1
%NOHOTKEY        = 1
%NOIMAGELIST     = 1
%NOPIADDRESS     = 1
%NOLIST          = 1
'%NOLISTVIEW      = 1
%NOMONTHCAL      = 1
%NONATIVEFONTCTL = 1
%NOPAGESCROLLER  = 1
%NOPROGRESS      = 1
%NOREBAR         = 1
%NOSTATUSBAR     = 1
%NOTABCONTROL    = 1
%NOTOOLBAR       = 1
%NOTOOLTIPS      = 1
%NOTRACKBAR      = 1
%NOTREEVIEW      = 1
%NOUPDOWN        = 1


#Include "WIN32API.INC"
#Include "COMMCTRL.INC"

%ID_LISTVIEW = 300

%ITEM_COUNT = 30000000

'*******************************************************************************

' Function Prototype

'*******************************************************************************

Declare Function InitApplication() As Long
Declare Function InitInstance(Long) As Long
Declare Function MainWndProc(ByVal Long, ByVal Long, ByVal Long, ByVal Long) As Long
Declare Function ListViewNotify(ByVal Long, ByVal Long) As Long
Declare Function CreateListView(ByVal Long, ByVal Dword) As Long
Declare Sub ResizeListView(ByVal Long, ByVal Long)
Declare Sub InitListView(ByVal Long)

'*******************************************************************************

' Global Variable

'*******************************************************************************

Global g_hInst As Long
Global g_szClassName As Asciiz * 32

'*******************************************************************************

' WinMain

'*******************************************************************************

Function WinMain (ByVal hInstance     As Long, _
                  ByVal hPrevInstance As Long, _
                  lpCmdLine           As Asciiz Ptr, _
                  ByVal nCmdShow      As Long) As Long

    Local Msg As tagMSG
    Local InitCommCtrl As INIT_COMMON_CONTROLSEX

    g_hInst = hInstance

    If (IsFalse(InitApplication())) Then
        Function = %False
        Exit Function
    End If

    InitCommCtrl.dwICC = %ICC_LISTVIEW_CLASSES
    InitCommCtrl.dwSize = SizeOf(InitCommCtrl)
    InitCommonControlsEx InitCommCtrl

    If (IsFalse(InitInstance(nCmdShow))) Then
        Function = %False
        Exit Function
    End If

    While GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
    Wend

  Function = msg.wParam

End Function

'*******************************************************************************

' InitApplication

'*******************************************************************************

Function InitApplication() As Long

    Local wcex As WNDCLASSEX

    g_szClassName = "GridClass"

    wcex.cbSize        = SizeOf(wcex)
    wcex.style         = 0
    wcex.lpfnWndProc   = CodePtr( MainWndProc )
    wcex.cbClsExtra    = 0
    wcex.cbWndExtra    = 0
    wcex.hInstance     = g_hInst
    wcex.hCursor       = LoadCursor( %NULL, ByVal %IDC_ARROW )
    wcex.hbrBackground = GetStockObject( %WHITE_BRUSH )
'    wcex.lpszMenuName  = %IDM_MAIN_MENU
    wcex.lpszClassName = VarPtr( g_szClassName )
    wcex.hIcon         = LoadIcon( %NULL, ByVal %IDI_APPLICATION )
    wcex.hIconSm       = LoadIcon( %NULL, ByVal %IDI_APPLICATION )

    Function = RegisterClassEx (wcex)

End Function

'*******************************************************************************

' InitInstance

'*******************************************************************************

Function InitInstance(nCmdShow As Long) As Long

    Local hWnd As Long
    Local szTitle As Asciiz * 64

    szTitle = "Grid"
    hWnd = CreateWindowEx(  0, _
                            g_szClassName, _
                            szTitle, _
                            %WS_OVERLAPPEDWINDOW, _
                            %CW_USEDEFAULT, _
                            %CW_USEDEFAULT, _
                            %CW_USEDEFAULT, _
                            %CW_USEDEFAULT, _
                            ByVal %NULL, _
                            ByVal %NULL, _
                            g_hInst, _
                            ByVal %NULL)

    If (IsFalse(hWnd)) Then
        Function = %False
        Exit Function
    End If

    ShowWindow hWnd, nCmdShow
    UpdateWindow hWnd
    Function = %True

End Function

'*******************************************************************************

' MainWndProc

'*******************************************************************************

Function MainWndProc (  ByVal hWnd As Long, _
                        ByVal uMessage As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) Export As Long

    Static hwndListView As Long
    Local pnmh As NMHDR Ptr

    Select Case uMessage

        Case %WM_CREATE
            hwndListView = CreateListView(hWnd, %ID_LISTVIEW)
            InitListView hwndListView

        Case %WM_NOTIFY
            pnmh = lParam
            If @pnmh.idFrom = %ID_LISTVIEW Then
                Function = ListViewNotify(@pnmh.hwndFrom, lParam)
            End If
            Exit Function

        Case %WM_SIZE
            ResizeListView hwndListView, hWnd

        Case %WM_COMMAND
            Select Case LoWrd(wParam)

            End Select

        Case %WM_DESTROY
            PostQuitMessage 0

    End Select

    Function = DefWindowProc(hWnd, uMessage, wParam, lParam)

End Function

'*******************************************************************************

' CreateListView

'*******************************************************************************

Function CreateListView(    ByVal hwndParent As Long, _
                            ByVal ListViewID As Dword) As Long

    Local dwStyle As Dword
    Local dwExStyle As Dword
    Local hwndListView As Long

    dwStyle =   %WS_TABSTOP Or _
                %WS_CHILD Or _
                %WS_BORDER Or _
                %WS_VISIBLE Or _
                %LVS_AUTOARRANGE Or _
                %LVS_REPORT Or _
                %LVS_OWNERDATA

    hwndListView = CreateWindowEx ( %WS_EX_CLIENTEDGE, _
                                    $WC_LISTVIEW, _
                                    "", _
                                    dwStyle, _
                                    0, _
                                    0, _
                                    0, _
                                    0, _
                                    hwndParent, _
                                    ListViewID, _
                                    g_hInst, _
                                    ByVal %NULL )

    If (IsFalse(hwndListView)) Then
        Function = %NULL
        Exit Function
    End If

    ResizeListView hwndListView, hwndParent

    dwExStyle = %LVS_EX_GRIDLINES Or %LVS_EX_FULLROWSELECT
    ListView_SetExtendedListViewStyleEx hwndListView, dwExStyle, dwExStyle

    Function = hwndListView

End Function

'*******************************************************************************

' ResizeListView

'*******************************************************************************

Sub ResizeListView( ByVal hwndListView As Long, _
                    ByVal hwndParent As Long)

   Local rc As RECT

   GetClientRect hwndParent, rc

   MoveWindow   hwndListView, _
                rc.nleft, _
                rc.ntop, _
                rc.nright - rc.nleft, _
                rc.nbottom - rc.ntop, _
                %TRUE

End Sub

'*******************************************************************************

' InitListView

'*******************************************************************************

Sub InitListView (ByVal hwndListView As Long)

    Local lvColumn As LV_COLUMN
    Local i As Long
    Local szString As Asciiz * 16


    lvColumn.fmt = %LVCFMT_LEFT
    lvColumn.cx = 120
    lvColumn.mask = %LVCF_FMT Or _
                    %LVCF_WIDTH Or _
                    %LVCF_TEXT Or _
                    %LVCF_SUBITEM

    For i = 0 To 5
        szString = "Column " & Str$(i)
        lvColumn.pszText = VarPtr(szString)
        ListView_InsertColumn hwndListView, i, lvColumn
    Next i

   ListView_DeleteAllItems hwndListView
   ListView_SetItemCountEx hwndListView, %ITEM_COUNT, %LVSICF_NOINVALIDATEALL

End Sub

'*******************************************************************************

' ListViewNotify

'*******************************************************************************

Function ListViewNotify(    ByVal hwndListView As Long, _
                            ByVal lParam As Long) As Long

    Local pnmh As NMHDR Ptr
    Local lpLVDispInfo As LV_DISPINFO Ptr
    Local lplvcd As NMLVCUSTOMDRAW Ptr
    Local szString As Asciiz * 256

    pnmh = lParam

    Select Case @pnmh.code
        
        Case %NM_CUSTOMDRAW
            lplvcd = lParam
            If(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) Then
                Function = %CDRF_NOTIFYITEMDRAW
                Exit Function
            End If

            If(@lplvcd.nmcd.dwDrawStage =  %CDDS_ITEMPREPAINT)  Then
                If (@lplvcd.nmcd.dwItemSpec Mod 2) = 0 Then
                    @lplvcd.clrTextBk = Rgb(200,200,200)
                End If
                Function = %CDRF_NEWFONT
                Exit Function
            End If

        Case %LVN_GETDISPINFO
            lpLVDispInfo = lParam
            If (@lpLVDispInfo.item.mask And %LVIF_TEXT) Then
                szString =  "Item " & Str$(@lpLVDispInfo.item.iItem) & _
                            " - Column " & Str$(@lpLVDispInfo.item.iSubItem)
                @lpLVDispInfo.item.pszText = VarPtr(szString)
            End If

        Case %LVN_ODCACHEHINT

    End Select

    Function = 0

End Function

'*******************************************************************************

' THE END

'*******************************************************************************

RValois.

------------------