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

Simple virtual listview with row header for PBWin10

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

  • PBWin Simple virtual listview with row header for PBWin10

    ' This is a further development of my previous virtual listview source
    ' code. This code incorporates some valuable tips from this link: http://www.powerbasic.com/support/pb...709#post386709
    '
    ' Besides the row header, alternate lines are given different colors.
    ' You can easily expand this to more colors and special fonts - also
    ' on specific subitems. Good luck.
    '
    ' Best regards,
    '
    ' Erik

    Code:
    ' Simple virtual listview with row header for PBWin10
    '
    ' This is a further development of my previous virtual listview source
    ' code. This code incorporates some valuable tips from this link: http://www.powerbasic.com/support/pbforums/showthread.php?p=386709#post386709
    '
    ' Besides the row header, alternate lines are given different colors.
    ' You can easily expand this to more colors and special fonts - also
    ' on specific subitems. Good luck.
    '
    ' Best regards,
    '
    ' Erik
    
    #COMPILE EXE
    #DIM ALL
    
    ' ************************************************************************
    #OPTION ANSIAPI ' necessary if using PBWin10 - may otherwise be excluded
    ' ************************************************************************
    
    #INCLUDE ONCE "WIN32API.INC"
    #INCLUDE ONCE "COMMCTRL.INC"
    #INCLUDE ONCE "PBForms.INC"
    '
    %IDD_DIALOG1               =  101
    %IDC_LISTVIEW1             = 1001
    %IDC_SCROLLBAR2_VERTICAL   = 1003
    %IDC_SCROLLBAR1_HORIZONTAL = 1002
    %IDC_FRAME1                = 1004
    '
    CALLBACK FUNCTION ShowDIALOG1Proc()
    
        STATIC i AS LONG, j AS LONG, k AS LONG
        STATIC Rows AS LONG, Columns AS LONG
        STATIC xPos AS LONG, xPage AS LONG, xMin AS LONG, xMax AS LONG
        STATIC yPos AS LONG, yPage AS LONG, yMin AS LONG, yMax AS LONG
    
        LOCAL my_LpLvNm AS NM_LISTVIEW PTR
        LOCAL lpLVDispInfo AS LV_DISPINFO PTR
        LOCAL lplvcd AS NMLVCUSTOMDRAW PTR
        LOCAL szString AS ASCIIZ * 256
    
        SELECT CASE AS LONG CB.MSG
            CASE %WM_INITDIALOG
                ' Initialization handler
    
                ' Specification of size of array.
                ' You may test other sizes.
                Rows=100
                Columns=500
                '
                ' Two empty columns are being added.
                DIM DataArray(0 TO Columns + 2, 0 TO Rows) AS STATIC STRING ' Column zero and row zero are used for headers.
                DIM ColWidth(0 TO Columns+2) AS STATIC LONG ' Each column may have it own width if you want that at some time.
                ' Fill array with data
                FOR i = 0 TO Columns
                    FOR j = 0 TO Rows
                        IF i = 0 THEN      ' Column zero is used for row headers.
                            IF j = 0 THEN  ' Label of row header column.
                                DataArray(i, j)= " row"
                            ELSE           ' Text of row headers.
                                DataArray(i, j)= " row" + STR$(j)
                            END IF
                        ELSE               ' i >= 1
                            IF j = 0 THEN  ' Row zero is used for column headers.
                                DataArray(i, j)= " column" + STR$(i)
                            ELSE           ' j >= 1  Item/subitem content
                                DataArray(i, j)= " column" + STR$(i) + " row" + STR$(j)
                            END IF
                        END IF
                    NEXT
                NEXT
                '
                ' Number of rows and columns in a displayed page
                yPage = 19
                xPage = 4
    
                LOCAL lStyle AS LONG
                LISTVIEW GET STYLEXX CBHNDL, %IDC_LISTVIEW1 TO lStyle
                LISTVIEW SET STYLEXX CBHNDL, %IDC_LISTVIEW1, lStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
                FOR i = 1 TO xPage + 3
                    LISTVIEW INSERT COLUMN CBHNDL, %IDC_LISTVIEW1, i, DataArray(i - 1, 0), 130, 0
                NEXT
                LOCAL hCtl AS LONG
                CONTROL HANDLE CBHNDL, %IDC_LISTVIEW1 TO hCtl
                listview_setitemcountex hctl, yPage, %lvsicf_noinvalidateall
    
    '         *************************************************************************************************************************
                SendMessage (hCtl, %WM_NOTIFYFORMAT, CBHNDL, %NF_REQUERY) ' necessary if using PBWin10 - may otherwise be excluded
    '         *************************************************************************************************************************
    
                yMin = 1 : yMax = Rows : yPos = 1
                SCROLLBAR SET PAGESIZE CBHNDL, %IDC_SCROLLBAR2_VERTICAL, yPage
                SCROLLBAR SET RANGE CBHNDL, %IDC_SCROLLBAR2_VERTICAL, yMin, yMax
    
                xMin = 1 : xMax = Columns : xPos = 1
                SCROLLBAR SET PAGESIZE CBHNDL, %IDC_SCROLLBAR1_HORIZONTAL, xPage
                SCROLLBAR SET RANGE CBHNDL, %IDC_SCROLLBAR1_HORIZONTAL, xMin, xMax
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CB.WPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_HSCROLL
                SELECT CASE LOWRD(CBWPARAM)' scroll message
                    CASE %SB_LINERIGHT     : INCR xPos
                    CASE %SB_PAGERIGHT     : xPos = xPos + xPage - 1
                    CASE %SB_LINELEFT      : DECR xPos
                    CASE %SB_PAGELEFT      : xPos = xPos - xPage + 1
                    CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : SCROLLBAR GET TRACKPOS CBHNDL, %IDC_SCROLLBAR1_HORIZONTAL TO xPos
                END SELECT
                xPos = MAX&(xMin, MIN&(xPos, xMax - xPage + 1)) ' Ensure that position is within range
                SCROLLBAR SET POS CBHNDL, %IDC_SCROLLBAR1_HORIZONTAL, xPos
                ' update column texts
                FOR i = 2 TO xPage + 3
                    LISTVIEW SET HEADER CBHNDL, %IDC_LISTVIEW1, i, DataArray(i + xPos - 2, 0)
                    LISTVIEW SET COLUMN CBHNDL, %IDC_LISTVIEW1, i, 130
                NEXT
                InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
    
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CBWPARAM)' scroll message
                    CASE %SB_LINEDOWN      : INCR yPos
                    CASE %SB_PAGEDOWN      : yPos = yPos + yPage - 1
                    CASE %SB_LINEUP        : DECR yPos
                    CASE %SB_PAGEUP        : yPos = yPos - yPage + 1
                    CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : SCROLLBAR GET TRACKPOS CBHNDL, %IDC_SCROLLBAR2_VERTICAL TO yPos
                END SELECT
                yPos = MAX&(yMin, MIN&(yPos, yMax - yPage + 1)) ' Ensure that position is within range
                SCROLLBAR SET POS CBHNDL, %IDC_SCROLLBAR2_VERTICAL, yPos
                InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
    
            CASE %WM_NOTIFY
                IF LOWRD(CBWPARAM)= %IDC_LISTVIEW1 THEN
                        my_LpLvNm = CBLPARAM
                        SELECT CASE @my_LpLvNm.hdr.code
                            CASE %NM_CUSTOMDRAW
                                lplvcd = CBLPARAM
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) THEN
                                    SetWindowLong CBHNDL,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_ITEMPREPAINT) THEN
                                    SetWindowLong CBHNDL,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_SUBITEM OR %CDDS_ITEMPREPAINT)  THEN
                                    k = @lplvcd.nmcd.dwItemSpec + yPos
                                    IF @lplvcd.iSubItem = 0 THEN             ' Row header
                                        IF k MOD 2 = 1 THEN @lplvcd.clrTextBk = RGB(245, 245, 245) ELSE @lplvcd.clrTextBk = RGB(230, 230, 230)
                                        @lplvcd.clrText = %BLACK             ' text color: black
                                        ' Specify a font of your choice if you like using: SelectObject @lplvcd.nmcd.hdc, hFont
                                    ELSE                                     ' Column 1 and beyond
                                        IF k MOD 2 = 1 THEN @lplvcd.clrTextBk = %WHITE ELSE @lplvcd.clrTextBk = %RGB_LIGHTCYAN
                                        @lplvcd.clrText = %BLACK
                                        ' Specify a font of your choice if you like using: SelectObject @lplvcd.nmcd.hdc, hFont
                                    END IF
                                    SetWindowLong CBHNDL,%DWL_MSGRESULT,(%CDRF_NEWFONT)' OR %CDRF_NOTIFYSUBITEMDRAW)
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                            CASE %LVN_GETDISPINFO    'Virtual ListView ask for Item text
                                lpLVDispInfo = CBLPARAM
                                IF (@lpLVDispInfo.item.mask AND %LVIF_TEXT) THEN
                                    ' Specify text to be used
                                    IF @lpLVDispInfo.item.iSubItem = 0 THEN ' row header
                                        szString = DataArray(0 , @lpLVDispInfo.item.iItem + yPos)
                                    ELSE                                    ' column 1 and beyond
                                        szString = DataArray(@lpLVDispInfo.item.iSubItem + xPos - 1 , @lpLVDispInfo.item.iItem + yPos)
                                    END IF
                                    @lpLVDispInfo.item.pszText = VARPTR(szString)
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                            CASE ELSE
                        END SELECT
                END IF
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CB.CTL
                    ' not used here
                END SELECT
        END SELECT
    END FUNCTION
    '
    FUNCTION PBMAIN()
        PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
            %ICC_INTERNET_CLASSES)
        LOCAL lRslt AS LONG
        LOCAL hDlg  AS DWORD
        DIALOG NEW PIXELS, 0, "Simple Virtual Listview With Row Header", , , 741, 410, _
            %WS_POPUP OR %WS_BORDER OR _
            %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
            %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
            %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
            OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD LISTVIEW,  hDlg, %IDC_LISTVIEW1, "", 20, 20, 680, _
            350, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LVS_REPORT OR _
            %LVS_SHOWSELALWAYS OR %LVS_NOSCROLL _ ' Please note the NOSCROLL style.
            OR %LVS_AUTOARRANGE OR %LVS_OWNERDATA, _
            %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
        CONTROL ADD SCROLLBAR, hDlg, %IDC_SCROLLBAR1_HORIZONTAL, "", 20, 370, _
            680, 20
        CONTROL ADD SCROLLBAR, hDlg, %IDC_SCROLLBAR2_VERTICAL, "", 700, 20, 20, _
            350, %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        CONTROL ADD FRAME,     hDlg, %IDC_FRAME1, "", 20, 12, 700, 380, %WS_CHILD _
            OR %WS_VISIBLE OR %BS_LEFT OR %BS_TOP OR %BS_GROUPBOX, _
             %WS_EX_LEFT OR %WS_EX_LTRREADING
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
        FUNCTION = lRslt
    END FUNCTION
Working...
X