Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

GRID - Virtual ListView - Colors and Fonts

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • GRID - Virtual ListView - Colors and Fonts

    Code:
    '*******************************************************************************
    
    '   GRID.BAS Sample for PB/DLL 6.0  Version 2
    
    '   GRID.BAS is a Virtual ListView (millions of items)
    '   with different colors and fonts.
    '
    '   Based on MSDN Samples
    
    '   THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND.
        
    '   26/07/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
    'In this sample, 30 MILLIONS items
    %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)
    Declare Function MakeFont(Font As Asciiz, Charset As Long, Bold As Long, Italic As Long, PointSize As Long) As Long
    
    '*******************************************************************************
    
    ' Global Variable
    
    '*******************************************************************************
    
    Global g_hInst As Long
    Global g_szClassName As Asciiz * 32
    Global hFont As Long
    
    '*******************************************************************************
    
    ' 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  = %NULL
        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.bas - Virtual ListView Sample with Fonts and Colors"
        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
                hFont =MakeFont ("Times New Roman", %ANSI_CHARSET, %FW_BOLD, %False, 12)
                
            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     'Virtual ListView will request for items when needed
                                       'through %LVN_GETDISPINFO message
                                       
        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
    
    '    Local pCachehint As NMLVCACHEHINT Ptr     ' see %LVN_ODCACHEHINT
    
        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
                        SelectObject @lplvcd.nmcd.hdc, hFont        'Item Font
                    Else
                        @lplvcd.clrTextBk = Rgb(200,200,200)        'Item Text Background Color
                        @lplvcd.clrText = Rgb(128,0,0)              'Item Text Color
                    End If
                    Function = %CDRF_NEWFONT                        'Return CDRF_NOTIFYSUBITEMREDRAW
                                                                    'to customize the item's subitems individually then
                                                                    'case CDDS_SUBITEM | CDDS_ITEMPREPAINT
                    Exit Function
                End If
    
            Case %LVN_GETDISPINFO    'Virtual ListView ask for Item text
                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
                ' pCachehint =lParam
                ' This sample does not use cache.
                ' you can cache items From pCachehint.iFrom To pCachehint.iTo
                ' Remember, %LVN_GETDISPINFO may ask for items not in cache too.
    
        End Select
    
        Function = 0
    
    End Function
    
    '*******************************************************************************
    
    ' MakeFont - From PB Forum, Thanks! (Don't remember who wrote, Sorry ...)
    
    '*******************************************************************************
    
    Function MakeFont(Font As Asciiz, Charset As Long, Bold As Long, Italic As Long, PointSize As Long) As Long
    
          Local hDC      As Long
          Local CyPixels As Long
    
          hDC = GetDC(%HWND_DESKTOP)
          CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
          ReleaseDC %HWND_DESKTOP, hDC
    
          Function = CreateFont(MulDiv(PointSize, CyPixels, 72), 0, 0, 0, Bold, Italic, 0, 0, _
             CharSet, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, %FF_DONTCARE, Font)
    
    End Function
    
    '*******************************************************************************
    
    ' THE END
    
    '*******************************************************************************
    ------------------


    [This message has been edited by Roberto Valois (edited July 26, 2001).]
    http://www.rvalois.com.br/downloads/free/

  • #2
    ' Virtual listview with color and font specification for each subitem.
    '
    ' This program is a modified and extended version of Roberto's program
    ' above. This version illustrates in a much too colorful way the
    ' possibilities of giving each listview cell specific colors for background
    ' and text and a specific font according to your choice. Naturally in you
    ' projects you would be much more restricted and discrete in your choice
    ' than here.
    '
    ' The important part is the listview notification where listview asks for
    ' the necessary data for each cell. All the information is held in data
    ' arrays and it is only the size of the memory that limits how large they
    ' can be. You may, however, find more efficient ways to hold the
    ' information.
    '
    ' I have tried without success also to do the project entirely using
    ' PowerBasic DDTs. (That version is not included here.) The problem seems
    ' to be in the listview notification part where I cannot get the
    ' CASE %NM_CUSTOMDRAW section to work, while the CASE %LVN_GETDISPINFO
    ' section works without problems. It may have to do with
    ' FUNCTION =%CDRF_NOTIFYSUBITEMDRAW OR %CDRF_NEWFONT not getting back to
    ' Windows. Can it be caused by a limitation of DDTs in this respect or is
    ' another explanation more likely?
    '
    ' Any comments you may have could go to this address:
    '
    ' Best wishes
    '
    ' Erik Christensen, Copenhagen, Denmark ----- e.chr@email.dk
    '
    ' P.S. November 17th, 2001: The notify customdraw section has been improved.
    Code:
    '*******************************************************************************
    '   GRID.BAS Sample for PB/DLL 6.0
    '   GRID.BAS is a Virtual ListView
    '   with different colors and fonts.
    '
    '   Based on MSDN Samples
    '   THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND.
    
    '   26/07/2001 RValois Informática
    '
    '   Modified and extended by Erik Christensen 11/11/2001
    '   e.chr@email.dk
    '
    '*******************************************************************************
    #DIM ALL
    #REGISTER NONE
    #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 = 1003
    %COLUMN_COUNT = 5
    '
    '*******************************************************************************
    ' 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)
    DECLARE FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
        BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
        BYVAL FaceName AS STRING) AS LONG
    '*******************************************************************************
    ' Global Variable
    '*******************************************************************************
    GLOBAL g_hInst AS LONG
    GLOBAL g_szClassName AS ASCIIZ * 32
    GLOBAL hFont AS LONG, hFont2 AS LONG
    GLOBAL DataArray() AS STRING
    GLOBAL FontArray() AS LONG
    GLOBAL TextColorArray() AS LONG
    GLOBAL BackgrColorArray() AS LONG
    GLOBAL TextFont() AS LONG
    '*******************************************************************************
    ' 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  = %NULL
        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 = "Virtual ListView with Subitem Fonts and Colors"
        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
        LOCAL i AS LONG, j AS LONG
        SELECT CASE uMessage
            CASE %WM_CREATE
                CALL SpecifyDataColorsAndFonts
                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
                FOR i=0 TO 28
                    CALL DeleteObject (TextFont(i&))
                NEXT
                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     'Virtual ListView will request for items when needed
                                       'through %LVN_GETDISPINFO message
    
        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,hDC AS LONG
        LOCAL szString AS ASCIIZ * 16
    
        lvColumn.fmt = %LVCFMT_LEFT
        lvColumn.cx = 160
        lvColumn.mask = %LVCF_FMT OR _
                        %LVCF_WIDTH OR _
                        %LVCF_TEXT OR _
                        %LVCF_SUBITEM
        FOR i = 1 TO %COLUMN_COUNT
            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 - Modified by EC
    '*******************************************************************************
    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  ' Here you can specify font and color.
                ' Adjusted November 17th, 2001
                ' This more logical stepwise initialization of customdraw
                ' was suggested by Semen Matusovski
                lplvcd = lParam
                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) THEN ' Prepare painting
                    FUNCTION = %CDRF_NOTIFYITEMDRAW     ' Prepare to draw each item
                    EXIT FUNCTION
                END IF
                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_ITEMPREPAINT) THEN
                    FUNCTION = %CDRF_NOTIFYSUBITEMDRAW  ' Prepare to draw each subitem
                    EXIT FUNCTION
                END IF
                ' Here you specify color and font of each subitem
                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_SUBITEM OR %CDDS_PREPAINT) THEN
                    ' Specify background color
                    @lplvcd.clrTextBk = BackgrColorArray(@lplvcd.nmcd.dwItemSpec + 1,@lplvcd.iSubItem + 1)
                    ' Specify text color
                    @lplvcd.clrText = TextColorArray(@lplvcd.nmcd.dwItemSpec + 1,@lplvcd.iSubItem + 1)
                    ' Specify font
                    SelectObject @lplvcd.nmcd.hdc, FontArray(@lplvcd.nmcd.dwItemSpec + 1,@lplvcd.iSubItem + 1)
                    ' Instruct Windows to take care of these matters
                    FUNCTION =%CDRF_NOTIFYSUBITEMDRAW OR %CDRF_NEWFONT
                    EXIT FUNCTION
                END IF
            CASE %LVN_GETDISPINFO    'Virtual ListView ask for Item text
                lpLVDispInfo = lParam
                IF (@lpLVDispInfo.item.mask AND %LVIF_TEXT) THEN
                    ' Specify text to be used
                    szString =  DataArray(@lpLVDispInfo.item.iItem + 1 , @lpLVDispInfo.item.iSubItem + 1)
                    @lpLVDispInfo.item.pszText = VARPTR(szString)
                END IF
            CASE %LVN_ODCACHEHINT
                ' pCachehint =lParam
                ' This sample does not use cache.
                ' you can cache items From pCachehint.iFrom To pCachehint.iTo
                ' Remember, %LVN_GETDISPINFO may ask for items not in cache too.
        END SELECT
        FUNCTION = 0
    END FUNCTION
    '*******************************************************************************
    ' The following Subs and functions have been added by EC
    ' --------------------------------------------------------------
    SUB SpecifyDataColorsAndFonts
        LOCAL i&,j&, Red&, Green&, Blue&,KK&,II&,k&,l&,m&,JJ&
        DIM RainBowColors (0:71) AS LOCAL LONG
        DIM TextColor (0:71) AS LOCAL LONG
        REDIM TextFont (0:28)
        FOR i&=0 TO 359 STEP 5          ' one 360 degrees turn (color loop)
            CALL GetRainbowRGB(BYREF i&,BYREF Red&,BYREF Green&,BYREF Blue&)
            RainBowColors(i/5)=RGB(Red&,Green&,Blue&)
            ' Decide from color if text should be black or white
            ' This function is suited when transformation to a grey scale is needed.
            IF Red&*.222+Green&*.707+Blue&*.071>128 THEN  ' Color is light,
                TextColor(i/5)=RGB(0,0,0)                 ' then text should be black.
            ELSE                                          ' Color is dark,
                TextColor(i/5)=RGB(255,255,255)           ' then text should be white.
            END IF
        NEXT
        i&=0 :    TextFont(i)=MakeFont(8,700,0,0,0,"Papyrus")
        INCR i& : TextFont(i)=MakeFont(8,600,0,0,0,"Tempus Sans ITC")
        INCR i& : TextFont(i)=MakeFont(9,400,0,0,0,"Klang MT")
        INCR i& : TextFont(i)=MakeFont(9,400,0,0,0,"Eras Medium ITC")
        INCR i& : TextFont(i)=MakeFont(11,400,0,0,0,"Edwardian Script ITC")
        FOR k&=400 TO 700 STEP 300  ' FontWeight loop - normal or bold
            FOR l&=0 TO 1           ' Italic loop - normal or italic
                FOR m&=0 TO 1       ' Underline loop - normal or underline
                    INCR i& : TextFont(i)=MakeFont(8,k&,l&,m&,0,"Arial")
                    INCR i& : TextFont(i)=MakeFont(7,k&,l&,m&,0,"Courier New")
                    INCR i& : TextFont(i)=MakeFont(8,k&,l&,m&,0,"Times New Roman")
                NEXT
            NEXT
        NEXT
        REDIM DataArray(1:%ITEM_COUNT,1:%COLUMN_COUNT)
        REDIM FontArray(1:%ITEM_COUNT,1:%COLUMN_COUNT)
        REDIM TextColorArray(1:%ITEM_COUNT,1:%COLUMN_COUNT)
        REDIM BackgrColorArray(1:%ITEM_COUNT,1:%COLUMN_COUNT)
        ' Fill arrays to be used by listview for custom drawing
        KK&=-1
        FOR j=1 TO %COLUMN_COUNT
            FOR i=1 TO %ITEM_COUNT
                INCR KK&
                DataArray(i,j)="Row"+STR$(i)+"  Column"+STR$(j)
                BackgrColorArray(i,j)=RainBowColors(KK& MOD 72)
                TextColorArray(i,j)=TextColor(KK& MOD 72)
                FontArray(i,j)=TextFont(KK& MOD 29)
            NEXT
        NEXT
    END SUB
    ' ------------------------------------------------
    SUB GetRainbowRGB(BYREF i&,BYREF Red&,BYREF Green&,BYREF Blue&)
        SELECT CASE i& 'i& can vary between 0 and 359 (full circle)
            CASE 0 TO 59
                Red&=(i& MOD 60)*4.25       ' increasing red
                Green&=255                  ' maximum green
                Blue&=0                     ' no blue
            CASE 60 TO 119
                Red&=255                    ' maximum red
                Green&=255-(i& MOD 60)*4.25 ' decreasing green
                Blue&=0                     ' no blue
            CASE 120 TO 179
                Red&=255                    ' maximum red
                Green&=0                    ' no green
                Blue&=(i& MOD 60)*4.25      ' increasing blue
            CASE 180 TO 239
                Red&=255-(i& MOD 60)*4.25   ' decreasing red
                Green&=0                    ' no green
                Blue&= 255                  ' maximum blue
            CASE 240 TO 299
                Red&=0                      ' no red
                Green&=(i& MOD 60)*4.25     ' increasing green
                Blue& = 255                 ' maximum blue
            CASE 300 TO 359
                Red&=0                      ' no red
                Green&=255                  ' maximum green
                Blue&=255-(i& MOD 60)*4.25  ' decreasing blue
            CASE ELSE
        END SELECT
    END SUB
    ' ------------------------------------------------
    FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
        BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
        BYVAL FaceName AS STRING) AS LONG
        LOCAL lfFont AS LOGFONT, hDC AS LONG,LogPixelsY AS LONG
    ' -----------------------
        'TYPE LOGFONT defines the attributes of a font.
        'See LOGFONT in the Win32 help file
        hDC = GetDC(%HWND_DESKTOP)
        '
        'Retrieves device-specific information about the number
        'of pixels per logical inch along the screen height
        '(depends on screen resolution setting).
        'This is important to define appropriate font sizes.
        LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
        '
        ReleaseDC %HWND_DESKTOP, hDC
        '
        lfFont.lfHeight = -MulDiv(FontTypeSize,LogPixelsY,72) '-(FontTypeSize * LogPixelsY) \ 72
                                                ' logical height of font
        lfFont.lfWidth = 0                      ' logical average character width
        lfFont.lfEscapement = 0                 ' angle of escapement
        lfFont.lfOrientation = 0                ' base-line orientation angle
        lfFont.lfWeight = FontWeight            ' font weight
        lfFont.lfItalic = Italic                ' italic attribute flag (0,1)
        lfFont.lfUnderline = Underline          ' underline attribute flag (0,1)
        lfFont.lfStrikeOut = StrikeOut          ' strikeout attribute flag (0,1)
        lfFont.lfCharSet = %ANSI_CHARSET        ' character set identifier
        lfFont.lfOutPrecision = %OUT_TT_PRECIS  ' output precision
        lfFont.lfClipPrecision = %CLIP_DEFAULT_PRECIS  ' clipping precision
        lfFont.lfQuality = %DEFAULT_QUALITY     ' output quality
        lfFont.lfPitchAndFamily = %FF_DONTCARE  ' pitch and family
        lfFont.lfFaceName = FaceName            ' typeface name string
    ' -----------------------
        ' Make font according to specifications
        FUNCTION = CreateFontIndirect (lfFont)
    END FUNCTION
    ' ------------------------------------------------

    [This message has been edited by Erik Christensen (edited November 17, 2001).]

    Comment


    • #3
      erik, you are having the same problem that i encountered. lance came up with the solution.
      quote:
      ------------------------------------------
      ' i have tried without success also to do the project entirely using
      ' powerbasic ddts. (that version is not included here.) the problem seems
      ' to be in the listview notification part where i cannot get the
      ' case %nm_customdraw section to work, while the case %lvn_getdispinfo
      ' section works without problems. it may have to do with
      ' function =%cdrf_notifysubitemdraw or %cdrf_newfont not getting back to
      ' windows.
      ------------------------------------------

      check out http://www.powerbasic.com/support/pb...ad.php?t=18611

      this should get you going.

      david kenny

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


      [this message has been edited by david kenny (edited november 13, 2001).]

      Comment


      • #4
        FYI: Erik's code produces an Access Violation under NT4 as soon the code is run.
        If you want me to check revised code under NT, send it to my email address below.

        Regards,

        Hank

        ------------------
        Henk Broekhuizen,
        pbforums@henkhenk.com
        The Netherlands
        Henk Broekhuizen, PA3BLP
        powerbasicforum -at- doorhet.net
        Sexbierum, The Netherlands
        ========================

        Comment


        • #5
          Henk and others who may have experienced problems with the program,

          The notify for customdraw has been improved. It has now a more
          logical structure and should work better.

          I hope that this now also works satisfactorily on systems different
          from my own. If you still experience problems, please let me know.

          Sorry for the inconvenience.

          Erik


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

          Comment


          • #6
            Revised code (17NOV2001) tested on NT and now works OK. Thanks for sharing and adapting it. Wonderful results!

            Regards,

            Henk

            ------------------
            Henk Broekhuizen,
            pbforums@henkhenk.com
            The Netherlands
            Henk Broekhuizen, PA3BLP
            powerbasicforum -at- doorhet.net
            Sexbierum, The Netherlands
            ========================

            Comment


            • #7
              Neither the version of Roberto Valois or that of Erik Christensen
              will compile in PBW-8. Could someone[s] fix that so I can see
              the pretty demos? (I know that Erik is now away.)
              thnx

              ------------------
              Don M. / aka thimk at thimk dot biz
              http://powerbasic.thimk.biz/
              Don M. / aka thimk at thimk dot biz

              http://powerbasic.thimk.biz/

              Comment


              • #8
                The fix is simple. And the results are impressive.

                Correct this line in the WinMain to look like:

                [bold]BYVAL[/bold] lpCmdLine AS ASCIIZ PTR

                and give lvColumn a unique name (such as lv) in the InitListView Sub.

                Then it works great

                ------------------
                I'm trying, I'm really trying...

                [This message has been edited by Mike Smith (edited December 15, 2005).]
                If virtue and knowledge are diffused among the people, they will never be enslaved. -Sam Adams

                Comment


                • #9
                  Mike, many thanks for your fast response and good advice.

                  Erik's version ran with your changes, but Roberto's stopped compiling at
                  DECLARE FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _

                  Copying in that function name and declaration from Erik's did not
                  suffice.

                  Erik's version works, so now I'll try learning from it.

                  ------------------
                  Don M. / aka thimk at thimk dot biz
                  http://powerbasic.thimk.biz/
                  Don M. / aka thimk at thimk dot biz

                  http://powerbasic.thimk.biz/

                  Comment


                  • #10
                    Code:
                    '*******************************************************************************
                    
                    '   GRID.BAS Sample for PB/DLL 6.0  Version 3
                    
                    '   GRID.BAS is a Virtual ListView (millions of items)
                    '   with different colors and fonts.
                    '
                    '   Based on MSDN Samples
                    
                    '   THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND.
                    
                    '   26/07/2001 RValois Informática
                    
                    '*******************************************************************************
                    
                    '18/12/05 - Updated to compile with PB 8.01
                    
                    #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
                    'In this sample, 30 MILLIONS items
                    %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)
                    Declare Function MakeFont(ByRef zFont As Asciiz, Charset As Long, Bold As Long, Italic As Long, PointSize As Long) As Long
                    
                    '*******************************************************************************
                    
                    ' Global Variable
                    
                    '*******************************************************************************
                    
                    Global g_hInst As Long
                    Global g_szClassName As Asciiz * 32
                    Global hFont As Long
                    
                    '*******************************************************************************
                    
                    ' WinMain
                    
                    '*******************************************************************************
                    
                    Function WinMain (ByVal hInstance     As Long, _
                                      ByVal hPrevInstance As Long, _
                                      ByVal 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  = %NULL
                        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.bas - Virtual ListView Sample with Fonts and Colors"
                        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
                                hFont =MakeFont ("Times New Roman", %ANSI_CHARSET, %FW_BOLD, %False, 12)
                    
                            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     'Virtual ListView will request for items when needed
                                                       'through %LVN_GETDISPINFO message
                    
                        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 lvCol As LV_COLUMN
                        Local i As Long
                        Local szString As Asciiz * 16
                    
                    
                        lvCol.fmt = %LVCFMT_LEFT
                        lvCol.cx = 120
                        lvCol.mask = %LVCF_FMT Or _
                                        %LVCF_WIDTH Or _
                                        %LVCF_TEXT Or _
                                        %LVCF_SUBITEM
                    
                        For i = 0 To 5
                            szString = "Column " & Str$(i)
                            lvCol.pszText = VarPtr(szString)
                            ListView_InsertColumn hwndListView, i, lvCol
                        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
                    
                    '    Local pCachehint As NMLVCACHEHINT Ptr     ' see %LVN_ODCACHEHINT
                    
                        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
                                        SelectObject @lplvcd.nmcd.hdc, hFont        'Item Font
                                    Else
                                        @lplvcd.clrTextBk = RGB(200,200,200)        'Item Text Background Color
                                        @lplvcd.clrText = RGB(128,0,0)              'Item Text Color
                                    End If
                                    Function = %CDRF_NEWFONT                        'Return CDRF_NOTIFYSUBITEMREDRAW
                                                                                    'to customize the item's subitems individually then
                                                                                    'case CDDS_SUBITEM | CDDS_ITEMPREPAINT
                                    Exit Function
                                End If
                    
                            Case %LVN_GETDISPINFO    'Virtual ListView ask for Item text
                                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
                                ' pCachehint =lParam
                                ' This sample does not use cache.
                                ' you can cache items From pCachehint.iFrom To pCachehint.iTo
                                ' Remember, %LVN_GETDISPINFO may ask for items not in cache too.
                    
                        End Select
                    
                        Function = 0
                    
                    End Function
                    
                    '*******************************************************************************
                    
                    ' MakeFont - From PB Forum, Thanks! (Don't remember who wrote, Sorry ...)
                    
                    '*******************************************************************************
                    
                    Function MakeFont(ByRef zFont As Asciiz, Charset As Long, Bold As Long, Italic As Long, PointSize As Long) As Long
                    
                          Local hDC      As Long
                          Local CyPixels As Long
                    
                          hDC = GetDC(%HWND_DESKTOP)
                          CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                          ReleaseDC %HWND_DESKTOP, hDC
                    
                          Function = CreateFont(MulDiv(PointSize, CyPixels, 72), 0, 0, 0, Bold, Italic, 0, 0, _
                             CharSet, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, %FF_DONTCARE, zFont)
                    
                    End Function
                    
                    '*******************************************************************************
                    
                    ' THE END
                    ------------------
                    http://www.rvalois.com.br/downloads/free/
                    http://www.rvalois.com.br/downloads/free/

                    Comment


                    • #11
                      Thanks, Roberto.

                      ------------------
                      Don M. / aka thimk at thimk dot biz
                      http://powerbasic.thimk.biz/
                      Don M. / aka thimk at thimk dot biz

                      http://powerbasic.thimk.biz/

                      Comment

                      Working...
                      X