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

Very simple virtual list-view with row header

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

  • Very simple virtual list-view with row header

    ' very simple virtual listview with row header
    '
    ' this simple solution actually uses two virtual listviews, one for the
    ' data, the other for the row header. it works ok for controls which are
    ' not having a very big window and which have a limited number of columns.
    '
    ' you can use either of two vertical scroll bars, which work in synchrony.
    ' the vertical scroll bar of the row header is put on its left side.
    '
    ' the number of rows does not influence performance that much, and the
    ' limit of the number of rows is only set by the available memory.
    ' if the number of columns is big, the horizontal scrolling performance is
    ' slowed considerably. there may be a limit to how many columns you will
    ' be able to display. in my system the maximum number of columns is 537.
    ' that number may be dependent on the system used in each particular case.
    '
    ' my previous virtual listviews do not have such limitations.
    ' the best of those you can find in these links:
    http://www.powerbasic.com/support/pb...ad.php?t=24697
    http://www.powerbasic.com/support/pb...ad.php?t=23229
    http://www.powerbasic.com/support/pb...ad.php?t=24782
    '
    ' best regards,
    '
    ' erik christensen --------- november 26, 2005
    '
    ' p.s. 28 november, 2005: minor improvements made in sub synchronizelistviews.
    ' 30 november, 2005: further minor improvements have been made.
    ' 1 december, 2005: other small changes have been made, hopefully the last.
    Code:
    #compile exe
    #register none
    #dim all
    '
    #include "win32api.inc"
    #include "commctrl.inc"
    %idc_listview400   = 400
    %idc_listview410   = 410
    %idc_button440     = 440
    '----------------------------------------------------------------------
    %noanimate         = 1  ' animate control
    %nobutton          = 1  ' button
    %nocombo           = 1  ' combo box
    %nocomboex         = 1  ' comboboxex
    %nodatetimepick    = 1  ' date/time picker
    %nodraglist        = 1  ' drag list control
    %noedit            = 1  ' edit control
    %noflatsbapis      = 1  ' flat scroll bar
    %noheader          = 1  ' header control
    %nohotkey          = 1  ' hotkey control
    %noimagelist       = 1  ' image apis
    %noipaddress       = 1  ' ip address edit control
    %nolist            = 1  ' list box control
    '%nolistview        = 1  ' listview control
    %nomenuhelp        = 1  ' menu help
    %nomonthcal        = 1  ' monthcal
    %nomui             = 1  ' mui
    %nonativefontctl   = 1  ' native font control
    %nopagescroller    = 1  ' pager
    %noprogress        = 1  ' progress control
    %norebar           = 1  ' rebar control
    %nostatusbar       = 1  ' status bar
    %notabcontrol      = 1  ' tab control
    %notoolbar         = 1  ' tool bar
    %notooltips        = 1  ' tool tips
    %notrackbar        = 1  ' track bar
    %notrackmouseevent = 1  ' track mouse event
    %notreeview        = 1  ' treeview
    %noupdown          = 1  ' up down arrow control
    '
    ' ------------------------------------------------
    function samplelistview(byval hdlg as dword, byval lid as long, byval lcolcnt as long, _
            byval lrowcnt as long, byref dataarray() as string, byval wi as long) as long
        local lcol   as long
        local lrow   as long
        local hctl   as dword
        local tlvc   as lv_column
        local tlvi   as lv_item
        local szbuf  as asciiz * 32
        local lstyle as long
        control handle hdlg, lid to hctl
        lstyle = listview_getextendedlistviewstyle(hctl)
        listview_setextendedlistviewstyle(hctl, lstyle or %lvs_ex_gridlines)
        ' load column headers.
        tlvc.mask    = %lvcf_fmt or %lvcf_text or %lvcf_subitem
        tlvc.psztext = varptr(szbuf)
        for lcol = 0 to lcolcnt-1
            tlvc.fmt = %lvcfmt_left
            if lcolcnt = 1 then szbuf = dataarray(lcol, 0) else szbuf = dataarray(lcol+1, 0)
            tlvc.iorder = lcol
            listview_insertcolumn(hctl, lcol, tlvc)
        next lcol
        ' size columns.
        for lcol = 0 to lcolcnt - 1
            sendmessage(hctl, %lvm_setcolumnwidth, lcol, maklng(wi, 0))
        next lcol
        listview_deleteallitems hctl
        listview_setitemcountex hctl, lrowcnt, %lvsicf_noinvalidateall
    end function
    '
    sub createdata(byref dataarray() as string, byval rows as long, byval columns as long)
        local i as long, j as long
        ' fill array with data
        dataarray(0,0)= "r\c"
        for i=1 to columns
            for j=0 to rows
                if j=0 then  ' row zero is used for column headers.
                    dataarray(i,j)= format$(i)
                else ' j >= 1  item/subitem content
                    dataarray(i,j)= "col"+str$(i)+" row"+str$(j)
                end if
            next
        next
    end sub
    '
    sub synchronizelistviews(byval h1 as dword, byval h2 as dword)
        local rc1 as rect, rc2 as rect, i as long, j as long, w as long
        '
        ' synchronize vertical scrolling
        rc1.nleft = %lvir_bounds : sendmessage h1, %lvm_getitemrect, 0, varptr(rc1)
        rc2.nleft = %lvir_bounds : sendmessage h2, %lvm_getitemrect, 0, varptr(rc2)
        sendmessage h2, %lvm_scroll, 0, rc2.ntop - rc1.ntop
        '
        ' ensure that left (row header) listview always has handle h2 in the following.
        getwindowrect h1, rc1 : getwindowrect h2, rc2 : if rc1.nleft < rc2.nleft then swap h1, h2
        '
        ' adjust column width of left (row header) listview to ensure same horizontal scroll bar status
        ' (present or absent) in both listviews. (if the column width is greater than the width of a
        ' listview, then a horizontal scroll bar is displayed - otherwise it is not displayed.)
        i = sendmessage(h1, %lvm_getcountperpage, 0, 0)
        j = sendmessage(h2, %lvm_getcountperpage, 0, 0)
        w = sendmessage(h2, %lvm_getcolumnwidth, 0, 0)
        do
            w = w + sgn(j - i) : sendmessage h2, %lvm_setcolumnwidth, 0, maklng(w, 0)
            j = sendmessage(h2, %lvm_getcountperpage, 0, 0)
        loop until i = j
        '
        ' ensure that left (row header) listview is always scrolled maximally to the left.
        rc2.nleft = %lvir_bounds : sendmessage h2, %lvm_getitemrect, 0, varptr(rc2)
        sendmessage h2, %lvm_scroll, rc2.nleft, 0
    end sub
    '
    '----------------------------------------------------------------------
    callback function dlgproc() as long
        static h1 as dword, h2 as dword
        static columns as long, rows as long
        static prevtime as double
        dim dataarray(1 to 1, 1 to 1) as static string
        static rowheaderwidth as long
        local rc as rect
        local pnmh as nmhdr ptr
        local lplvdispinfo as lv_dispinfo ptr
        local pnm as nmlvcustomdraw ptr
        local szstring as asciiz * 256
        '
        select case cbmsg
            case %wm_initdialog
                initcommoncontrols
                systemparametersinfo %spi_getworkarea, 0, byval varptr(rc), 0
                movewindow cbhndl,rc.nleft, rc.ntop, rc.nright - rc.nleft, rc.nbottom - rc.ntop, %true
                control add "syslistview32", cbhndl, %idc_listview400, ", 0, 0, 0, 0, %ws_border or _
                    %ws_child  or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways _
                    or %lvs_ownerdata, %ws_ex_left or %ws_ex_rightscrollbar
                control add "syslistview32", cbhndl, %idc_listview410, ", 0, 0, 0, 0, %ws_border or _
                    %ws_child  or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways _
                   or %lvs_ownerdata, %ws_ex_left or %ws_ex_leftscrollbar
                control handle cbhndl, %idc_listview400 to h1
                control handle cbhndl, %idc_listview410 to h2
                getclientrect cbhndl, rc
                '
                rowheaderwidth = 80  '  width of left (row header) listview
                '
                movewindow h2, 100, 100, rowheaderwidth, rc.nbottom - 400, %true
                movewindow h1, 100 + rowheaderwidth - 1, 100, rc.nright - 291, rc.nbottom - 400, %true
                '
                columns = 6 : rows = 20000 ' number of columns and rows to be displayed.
                '
                redim dataarray(0 to columns, 0 to rows)
                call createdata(dataarray(), rows, columns)
                samplelistview cbhndl, %idc_listview400, columns, rows, dataarray(), 140
                samplelistview cbhndl, %idc_listview410, 1, rows, dataarray(), rowheaderwidth
                '
                ' if vertical scroll bar present then reduce column width of row header accordingly.
                if sendmessage(h2, %lvm_getcountperpage, 0, 0) < sendmessage(h2, %lvm_getitemcount, 0, 0) then
                    sendmessage h2, %lvm_setcolumnwidth, 0, maklng(rowheaderwidth - getsystemmetrics(%sm_cxvscroll), 0)
                end if
                '
                control add button, cbhndl, %idc_button440, "e&xit", 0, 0, 0, 0, _
                    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
                movewindow getdlgitem(cbhndl, %idc_button440), rc.nright - 100, rc.nbottom - 30, 90, 20, %true
            case %wm_command
                select case cbctl
                   case %idcancel      : if cbctlmsg = %bn_clicked then dialog end cbhndl, 0
                   case %idc_button440 : if cbctlmsg = %bn_clicked then dialog end cbhndl, 0
            end select
        case %wm_notify
            pnmh = cblparam
            select case @pnmh.code
                case %nm_customdraw  ' here you can specify font and color.
                    pnm = cblparam
                    select case @pnm.nmcd.dwdrawstage
                        case %cdds_prepaint
                            ' the following statement ensures that the relevant
                            ' messages are coming back to windows, so windows
                            ' can respond appropriately.
                            ' the following statement makes windows happy:
                            setwindowlong cbhndl,%dwl_msgresult,%cdrf_notifyitemdraw
                            ' this statement makes the ddt engine happy:
                            function = 1: exit function
                        case %cdds_itemprepaint
                            setwindowlong cbhndl,%dwl_msgresult,%cdrf_notifysubitemdraw
                            function = 1: exit function
                        case %cdds_subitem or %cdds_itemprepaint
                            if @pnmh.idfrom = %idc_listview400 then
                                if (@pnm.nmcd.dwitemspec mod 2) then
                                    @pnm.clrtextbk = rgb(200,255,255)
                                    @pnm.clrtext = %black
                                else
                                    @pnm.clrtextbk = %white
                                    @pnm.clrtext = %black
                                end if
                            elseif @pnmh.idfrom = %idc_listview410 then
                                ' specify background color
                                @pnm.clrtextbk = rgb(227,227,227) ' light gray
                                ' specify text color
                                @pnm.clrtext = %black
                            end if
                            setwindowlong cbhndl,%dwl_msgresult,(%cdrf_newfont or %cdrf_notifysubitemdraw)
                            function = 1: exit function
                    end select
                    '
                    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 @pnmh.idfrom = %idc_listview400 then
                                szstring =  dataarray(@lplvdispinfo.item.isubitem + 1, @lplvdispinfo.item.iitem + 1)
                            elseif @pnmh.idfrom = %idc_listview410 then
                                szstring =  ltrim$(str$(@lplvdispinfo.item.iitem + 1))
                            end if
                            @lplvdispinfo.item.psztext = varptr(szstring)
                        end if
                        select case @pnmh.idfrom
                            case %idc_listview400 : postmessage cbhndl, %wm_user + 401, 0, 0
                            case %idc_listview410 : postmessage cbhndl, %wm_user + 402, 0, 0
                        end select
                end select
            case %wm_user + 401
                if timer - prevtime > 0.15 and getfocus <> h1 then setfocus h1
                prevtime = timer : if getfocus = h1 then synchronizelistviews h1, h2
                '
            case %wm_user + 402
                if timer - prevtime > 0.15 and getfocus <> h2 then setfocus h2
                prevtime = timer : if getfocus = h2 then synchronizelistviews h2, h1
        end select
        '
    end function
    '
    function pbmain ()
      local hdlg as dword
      dialog new 0, "simple virtual list-view with row header", , , 0, 0, _
                  %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or _
                  %ds_center, %ws_ex_windowedge to hdlg
      dialog show modal hdlg, call dlgproc
    end function


    [this message has been edited by erik christensen (edited december 01, 2005).]

  • #2
    FYI: Improvements have been made in SUB SynchronizeListviews.

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

    Comment


    • #3
      A few minor improvements have been made to get the listview
      syncronization work satisfactorily at any number of items. I
      hope it works OK now.

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


      [This message has been edited by Erik Christensen (edited December 01, 2005).]

      Comment

      Working...
      X