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

Custom drawn virtual listview grid control with full selection capability

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

  • Custom drawn virtual listview grid control with full selection capability

    ' custom drawn virtual listview grid control with full
    ' selection capability - for pbwin 6.x and 7.x.
    '
    ' improved version july 12, 2003
    '
    ' according to your need this skeleton code may be expanded
    ' with editing, sorting and mouse dragging facilities. the
    ' latter will probably need a mouse hook. the custom drawing
    ' allows each cell to have its own background and foreground
    ' color as well as its own font.
    '
    ' at present there is only a modest utilization of such
    ' features. i leave further developments to you. you may see
    ' these links for previous colorful versions:
    http://www.powerbasic.com/support/pb...ad.php?t=23229
    http://www.powerbasic.com/support/pb...ad.php?t=24782

    ' the present version suppresses listview's built-in selection
    ' capability, which is limited either to the first column or
    ' to full rows. the suppression is done by omitting the
    ' %lvs_ex_fullrowselect style and maintaining a zero width
    ' of the first column. this makes it possible to devise
    ' selection of any group of cells to be copied to the
    ' clipboard and from there to other programs like word and
    ' excel. you can also copy the other way - e.g. from excel
    ' to the grid - via the clipboard. extended selection is
    ' invoked using f8 or via a shortcut menu obtained using
    ' the right mouse button. this menu is also used to select
    ' full rows and columns and for copying and pasting. the
    ' original format (font, alignment, color etc.) of the target
    ' cells is maintained after receiving the new data from the
    ' clipboard. only the content is changed.

    ' external scroll bars are replacing those of listview, which
    ' is defined using the %lvs_noscroll style. therefore
    ' listview needs only handle data being displayed at any
    ' one time plus a few extra columns as reserve. thus there
    ' is no limit to the number of rows and columns, which may
    ' be handled, other than the amount of available computer
    ' memory.

    ' since the virtual listview functions are not designed
    ' to work with the no-scroll style, the scroll messages
    ' need to be handled in a separate callback function to
    ' ensure smooth scrolling.

    ' in the present version alternate lines are given slightly
    ' different background colors. if you want grid-lines,
    ' these can easily be added by uncommenting this statement:
    ' "' i = i or %lvs_ex_gridlines" in callback function
    ' listviewwindowcallback.

    ' thanks to peter stephensen for the clipboard routines
    ' and to semen matusovski, david kenny, lance edmonds,
    ' borje hagsten and david l. morris for help in earlier
    ' virtual listview developmental phases.

    ' best of luck.

    ' erik christensen ------ e.chr@email.dk ------- june 21, 2003
    '
    ' july 12, 2003: some improvements have been made: the line
    ' height has been increased using a technique provided by
    ' edwin knoppert. an undo last paste has been added and the
    ' key scrolling performance has been improved somewhat to
    ' approach that of excel. the program structure has also been
    ' changed slightly and the font has been changed to arial.
    [CODE]
    #compile exe
    #register none
    #dim all
    '
    ' in this program only listview and header controls use the commctrl.inc file
    %noanimate = 1 ' animate control.
    %nobutton = 1
    %nocombo = 1
    %nodatetimepick = 1
    %nodraglist = 1 ' apis to make a listbox source and sink drag&drop actions.
    %noedit = 1
    %noflatsbapis = 1
    ' %noheader = 1 ' header bar control.
    %nohotkey = 1 ' hotkey control.
    ' %noimagelist = 1 ' imagelist apis.
    %noipaddress = 1
    %nolist = 1
    ' %nolistview = 1 ' listview control.
    %nomenuhelp = 1 ' apis to help manage menus, especially with a status bar.
    %nomonthcal = 1
    %nomui = 1
    %nonativefontctl = 1
    %nopagescroller = 1
    %noprogress = 1 ' progress gas gauge.
    %norebar = 1
    %nostatusbar = 1 ' status bar control.
    %notabcontrol = 1
    %notoolbar = 1 ' customizable bitmap-button toolbar control.
    %notooltips = 1
    %notrackbar = 1 ' customizable column-width tracking control.
    %notreeview = 1 ' treeview control.
    %noupdown = 1 ' up and down arrow increment/decrement control.
    '
    #include "win32api.inc"
    #include "commctrl.inc"
    '
    %listviewgrid = 100
    %exitbutton = 115
    %vertscrollbar = 135
    %horzscrollbar = 140
    %extsel = 145
    %extselset = 150
    '
    global hlistform& ' dialog handle
    global hlistframe& ' dialog handle
    global hlistwindow& ' dialog handle
    global rows as long ' total number of rows in array
    global columns as long ' total number of columns in array
    global pagerows as long ' number of rows on a page
    global pagecolumns as long ' number of columns on a page
    global dataarray() as string' two-dimensional text array to be displayed
    global colwidth() as long ' column width array
    global undolast() as string ' two-dimensional text array to store data prior to paste
    global six as scrollinfo
    global siy as scrollinfo
    global goldsubclassproc&
    global selx as long ' column selected
    global sely as long ' row selected
    global selectcol as long
    global selectrow as long
    global selectrowstart as long
    global selectcolstart as long
    global selymax&
    global selymin&
    global selxmax&
    global selxmin&
    global anchor&, undoflag&
    global listviewheaderheight&,listviewitemheight&
    global hmenuright&
    global colextra&
    ' --------------------------------------------------------------------------------
    callback function cbf_exit
    local res&
    res&=msgbox ("are you sure?",%mb_yesno or %mb_iconquestion ,"exit program?")
    if res&=%idyes then dialog end hlistframe&
    end function
    ' --------------------------------------------------------------------------------
    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
    hdc = getdc(%hwnd_desktop)
    logpixelsy = getdevicecaps(hdc, %logpixelsy)
    releasedc %hwnd_desktop, hdc
    lffont.lfheight = -muldiv(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
    function = createfontindirect (lffont)
    end function
    ' --------------------------------------------------------------------------------
    sub createdata(byref dataarray() as string,byref colwidth() as long,byref rows as long,byref columns as long)
    local i&,j&
    ' fill array with data
    for i&=0 to columns + colextra
    if i = 0 then colwidth(i&) = 46 else colwidth(i&) = 150
    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&)= "r\c"
    else ' ' text of row headers.
    if j<=rows then dataarray(i&,j&)= format$(j&)
    end if
    else ' i& >= 1
    if j&=0 then ' row zero is used for column headers.
    if i<= columns then dataarray(i&,j&)= format$(i&)
    else ' j& >= 1 item/subitem content
    if i& <= columns and j <= rows then dataarray(i&,j&)= "column"+str$(i&)+" row"+str$(j&)
    end if
    end if
    next
    next
    end sub
    ' --------------------------------------------------------------------------------
    ' thanks to peter stephensen who provided the essential features of the following three functions.
    function selectiontoclipboard(byref dataarray() as string, _
    byval xmin as long, byval xmax as long, _
    byval ymin as long, byval ymax as long) as long
    mouseptr 11
    local i as long, j as long
    local s as string
    for j = ymin to ymax
    for i = xmin to xmax
    if i < xmax then
    s = s + dataarray(i,j) + $tab
    else
    s = s + dataarray(i,j) + $crlf
    end if
    next
    next
    local hglob as long
    local hdata as long
    ' create a global memory object and copy the data into it
    hdata = globalalloc(%gmem_moveable or %gmem_ddeshare, byval len(s)+1)
    mouseptr 1
    if isfalse hdata then exit function
    hglob = globallock(hdata)
    if isfalse hglob then exit function
    movememory byval hglob, byval strptr(s), byval len(s)+1
    globalunlock hdata
    ' open the clipboard
    if isfalse(openclipboard(%null)) then globalfree hdata : exit function
    ' paste the data into the clipboard
    if isfalse(emptyclipboard) then exit function
    if isfalse(setclipboarddata(%cf_text, hdata)) then exit function
    if isfalse(closeclipboard) then exit function
    function = 1
    end function
    ' --------------------------------------------------------------------------------
    function textfromclipboard(txt as string) as long
    local hdata as asciiz ptr
    if openclipboard(%null) = 0 then exit function
    hdata = getclipboarddata (%cf_text)
    closeclipboard
    txt = @hdata
    function = 1
    end function
    ' --------------------------------------------------------------------------------
    function clipboardtogrid(byref dataarray() as string, _
    byval xpos as long, byval ypos as long, _
    byref xe as long,byref ye as long) as long
    local buffer as string
    local lines as long, tabs as long
    local l as long, t as long, incomplflg&
    if textfromclipboard(buffer) = 0 then exit function
    mouseptr 11
    lines = parsecount(buffer, $crlf) - 1
    tabs = parsecount(parse$(buffer,$crlf,1), $tab)
    xe = min(xpos+tabs-1,columns) : ye = min(ypos+lines-1,rows)
    '
    redim undolast(xpos to xe,ypos to ye)
    for t = 0 to tabs-1
    for l = 0 to lines-1
    if (xpos+t) <= xe and (ypos+l) <= ye then
    ' save data in undolast array before pasting
    undolast(xpos+t,ypos+l) = dataarray(xpos+t,ypos+l)
    dataarray(xpos+t,ypos+l) = parse$(parse$(buffer,$crlf,l+1),$tab,t+1)
    else
    incomplflg& = 1
    end if
    next l
    next t
    mouseptr 1
    undoflag& = 1
    function = 1
    if incomplflg& = 1 then function = 2
    end function
    ' --------------------------------------------------------------------------------
    function undolastpaste(byref a as long,byref b as long,byref c as long,byref d as long) as long
    'selectcolstart, selectrowstart, selectcol, selectrow
    local i&,j&
    mouseptr 11
    a = lbound(undolast) : c = ubound(undolast)
    b = lbound(undolast(2)) : d = ubound(undolast(2))
    for i = a to c
    for j = b to d
    ' restore data prior to last paste
    dataarray(i,j) = undolast(i,j)
    next
    next
    mouseptr 1
    undoflag& = 0
    function = 1
    end function
    ' --------------------------------------------------------------------------------
    callback function listviewwindowcallback
    ' callback handle cbhndl is: hlistwindow&
    local rc as rect
    static ptscursor as pointapi
    local szstring as asciiz * 256
    local i&,kk&,result&,jj&,ll&
    local headnotif as hd_notify ptr
    local lvnotmes as nm_listview ptr
    local pnmh as nmhdr ptr
    local lplvdispinfo as lv_dispinfo ptr
    local lplvcd as nmlvcustomdraw ptr
    local res&
    static hfatfont&, hnormfont&, hitalfont&, hheader&
    '
    select case cbmsg
    case %wm_initdialog
    '
    getclientrect cbhndl, rc
    hlistform& = createwindowex(0, "syslistview32", byval 0, _
    %ws_child or %ws_visible or %lvs_report or %lvs_noscroll or %lvs_autoarrange or %lvs_ownerdata,0,0, _
    rc.nright,rc.nbottom,cbhndl,%listviewgrid,getmodulehandle("),byval 0)
    i = sendmessage (hlistform&, %listviewgrid, %lvm_getextendedlistviewstyle, 0)
    ' if you want gridlines, then uncomment the next line:
    ' i = i or %lvs_ex_gridlines
    ' nb: the %lvs_ex_fullrowselect listview style should not be used in this program.
    sendmessage hlistform&, %lvm_setextendedlistviewstyle, 0, i
    '
    hnormfont& = makefont(9,400,0,0,0,"arial")
    hfatfont& = makefont(9,700,0,0,0,"arial")
    hitalfont& = makefont(9,400,1,0,0,"arial")
    sendmessage hlistform&,%wm_setfont,hnormfont&,maklng(%true,0)
    '
    ' set column header font
    hheader& = listview_getheader(hlistform&)
    sendmessage hheader&,%wm_setfont,hfatfont&,maklng(%true,0)
    '
    ' define shortcut menu.
    menu new popup to hmenuright&
    menu add string, hmenuright&,"extended selection off",4,%mf_enabled
    menu add string, hmenuright&,"extended selection on",2,%mf_enabled
    menu add string, hmenuright&,"-",3,%mf_enabled
    menu add string, hmenuright&,"select full row(s)",5,%mf_enabled
    menu add string, hmenuright&,"select full column(s)",10,%mf_enabled
    menu add string, hmenuright&,"-",12,%mf_enabled
    menu add string, hmenuright&,"copy selection to clipboard",15,%mf_enabled
    menu add string, hmenuright&,"paste from clipboard",20,%mf_enabled
    menu add string, hmenuright&,"-",22,%mf_enabled
    menu add string, hmenuright&,"undo last paste",25,%mf_enabled
    menu attach hmenuright&, cbhndl
    checkmenuitem hmenuright&,4,%mf_checked
    '
    ' subclass listview
    goldsubclassproc = setwindowlong(hlistform&,%gwl_wndproc, codeptr(subclasskeys))
    '
    case %wm_notify
    if lowrd(cbwparam)= %listviewgrid then
    lvnotmes = cblparam
    select case @lvnotmes.hdr.code
    case %nm_click ' left mouse button click
    getcursorpos ptscursor
    screentoclient hlistform&, ptscursor
    kk& = (ptscursor.y - listviewheaderheight& - 1) \ listviewitemheight&
    if @lvnotmes.isubitem > 1 then
    selectrow = kk& + siy.npos
    selectcol = max(six.npos + @lvnotmes.isubitem - 2,1)
    if isfalse anchor then selectrowstart = selectrow : selectcolstart = selectcol
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    end if
    function = 1 : exit function
    case %nm_rclick ' right mouse button click: display shortcut menu
    getcursorpos ptscursor
    if istrue isclipboardformatavailable(%cf_text) then ' can paste
    enablemenuitem hmenuright&,20,%mf_enabled
    else
    enablemenuitem hmenuright&,20,%mf_grayed
    end if
    if istrue undoflag& then ' can undo
    enablemenuitem hmenuright&,25,%mf_enabled
    else
    enablemenuitem hmenuright&,25,%mf_grayed
    end if
    trackpopupmenuex hmenuright&,%tpm_leftalign or %tpm_vertical or %tpm_leftbutton or %tpm_rightbutton ,ptscursor.x,ptscursor.y,cbhndl,byval %null
    case %nm_customdraw
    lplvcd = cblparam
    if(@lplvcd.nmcd.dwdrawstage = %cdds_prepaint) then
    ' the following statement makes windows happy:
    setwindowlong hlistwindow&,%dwl_msgresult,%cdrf_notifyitemdraw
    ' this statement makes the ddt engine happy:
    function = 1: exit function
    end if
    if(@lplvcd.nmcd.dwdrawstage = %cdds_itemprepaint) then
    setwindowlong hlistwindow&,%dwl_msgresult,%cdrf_notifysubitemdraw
    function = 1: exit function
    end if
    if(@lplvcd.nmcd.dwdrawstage = %cdds_subitem or %cdds_itemprepaint) then
    if @lplvcd.isubitem <= 1 then ' row header (or dummy column)
    kk& = @lplvcd.nmcd.dwitemspec + siy.npos
    if kk& mod 2 = 1 then @lplvcd.clrtextbk = %ltgray else @lplvcd.clrtextbk = rgb(210,210,210)
    @lplvcd.clrtext = rgb(0,0,0) ' black
    selectobject @lplvcd.nmcd.hdc, hfatfont&
    else
    kk& = @lplvcd.nmcd.dwitemspec + siy.npos
    ll& = six.npos + @lplvcd.isubitem - 2
    if kk = selectrowstart and ll = selectcolstart then
    @lplvcd.clrtextbk = rgb(0,220,255)
    @lplvcd.clrtext = 0 ' black
    elseif kk >= selymin& and kk <= selymax& and ll >= selxmin& and ll <= selxmax& then
    @lplvcd.clrtextbk = rgb(170,200,250)
    @lplvcd.clrtext = 0 ' black
    else
    if kk& mod 2 = 1 then @lplvcd.clrtextbk = rgb(200,255,255) else @lplvcd.clrtextbk = rgb(255,255,255)
    @lplvcd.clrtext = 0 ' black
    end if
    if ll& mod 2 = 1 then selectobject @lplvcd.nmcd.hdc, hnormfont& else selectobject @lplvcd.nmcd.hdc, hitalfont&
    end if
    setwindowlong hlistwindow&,%dwl_msgresult,(%cdrf_newfont or %cdrf_notifysubitemdraw)
    function = 1: exit function
    end if
    case %lvn_getdispinfo 'virtual listview asks for item text
    lplvdispinfo = cblparam
    if (@lplvdispinfo.item.mask and %lvif_text) then
    ' specify text to be used
    if @lplvdispinfo.item.isubitem = 1 then ' row header
    szstring = dataarray(0 , @lplvdispinfo.item.iitem + siy.npos)'+1
    elseif @lplvdispinfo.item.isubitem > 1 then ' column 1 and beyond
    szstring = dataarray(@lplvdispinfo.item.isubitem + six.npos - 2 , @lplvdispinfo.item.iitem + siy.npos)
    else
    szstring = " ' dummy column
    end if
    @lplvdispinfo.item.psztext = varptr(szstring)
    function = 1: exit function
    end if
    case else
    end select
    end if
    '
    headnotif = cblparam
    if @headnotif.hdr.hwndfrom = hheader& then
    if @headnotif.hdr.code = %hdn_itemchanged then
    if @headnotif.iitem = 0 then ' maintain zero width of dummy column
    result&=sendmessage(hlistform&,%lvm_getcolumnwidth, 0, 0)
    if result&>0 then sendmessage hlistform&,%lvm_setcolumnwidth, 0, maklng(0, 0)
    end if
    end if
    end if
    case %wm_command ' right click menu
    select case cbwparam
    case 2 ' extended selection anchor on
    anchor = 1
    checkmenuitem hmenuright&,2,%mf_checked
    checkmenuitem hmenuright&,4,%mf_unchecked
    control set text hlistframe&,%extselset,"ext"
    case 4 ' extended selection anchor off
    anchor = 0
    checkmenuitem hmenuright&,4,%mf_checked
    checkmenuitem hmenuright&,2,%mf_unchecked
    selectrow = selectrowstart : selectcol = selectcolstart
    control set text hlistframe&,%extselset,"
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    case 5 ' select full row(s)
    selectcolstart = 1 : selectcol = columns
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    case 10 ' select full column(s)
    selectrowstart = 1 : selectrow = rows
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    case 15 ' copy selected data to clipboard
    anchor = 0
    checkmenuitem hmenuright&,4,%mf_checked
    checkmenuitem hmenuright&,2,%mf_unchecked
    control set text hlistframe&,%extselset,"
    res& = selectiontoclipboard(dataarray(),selxmin,selxmax,selymin,selymax)
    if isfalse res& then msgbox "could not copy to clipboard",%mb_iconerror,"problem:"
    case 20 ' paste clipboard data to grid at the focused cell
    anchor = 0
    checkmenuitem hmenuright&,4,%mf_checked
    checkmenuitem hmenuright&,2,%mf_unchecked
    control set text hlistframe&,%extselset,"
    res& = clipboardtogrid(dataarray(),selectcolstart,selectrowstart,selectcol,selectrow)
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    if isfalse res& then msgbox "could not paste from clipboard",%mb_iconerror,"problem:"
    if res& = 2 then msgbox "not all data in clipboard could be pasted onto grid due to insufficient space",%mb_iconwarning,"notice:"
    case 25 ' undo last paste to the grid
    anchor = 0
    checkmenuitem hmenuright&,4,%mf_checked
    checkmenuitem hmenuright&,2,%mf_unchecked
    control set text hlistframe&,%extselset,"
    res& = undolastpaste(selectcolstart,selectrowstart,selectcol,selectrow)
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    end select
    case %wm_destroy
    deleteobject hnormfont&
    deleteobject hfatfont&
    deleteobject hitalfont&
    ' important! remove the subclassing
    setwindowlong hlistform&, %gwl_wndproc, goldsubclassproc
    case else
    end select
    end function
    ' --------------------------------------------------------------------------------
    callback function subclasskeys
    ' subclass callback function for processing key messages.
    select case cbmsg
    case %wm_getdlgcode
    ' specify that we want all keys available here.
    function = %dlgc_wantallkeys: exit function
    case %wm_keydown ' keys at time of pressing
    select case cbwparam
    case %vk_up
    if selectrow > 1 then decr selectrow : siy.npos = min(siy.npos,selectrow)
    if selectrow = siy.npos - 1 then decr siy.npos
    if selectrow > siy.npos + pagerows then siy.npos = selectrow - pagerows + 1
    if selectcol < six.npos then six.npos = selectcol
    if selectcol > six.npos + pagecolumns then six.npos = selectcol - pagecolumns + 1
    case %vk_down
    if selectrow < rows then incr selectrow : siy.npos = min(siy.npos,selectrow)
    if selectrow = siy.npos + pagerows then incr siy.npos
    if selectrow > siy.npos + pagerows then siy.npos = selectrow - pagerows + 1
    if selectcol < six.npos then six.npos = selectcol
    if selectcol > six.npos + pagecolumns then six.npos = selectcol - pagecolumns + 1
    case %vk_left
    if selectcol > 1 then decr selectcol : six.npos = min(six.npos,selectcol)
    if selectcol = six.npos - 1 then decr six.npos
    if selectcol > six.npos + pagecolumns then six.npos = selectcol - pagecolumns + 1
    if selectrow < siy.npos then siy.npos = selectrow
    if selectrow > siy.npos + pagerows then siy.npos = selectrow - pagerows + 1
    case %vk_right
    if selectcol < columns then incr selectcol : six.npos = min(six.npos,selectcol)
    if selectcol = six.npos + pagecolumns then incr six.npos
    if selectcol > six.npos + pagecolumns then six.npos = selectcol - pagecolumns + 1
    if selectrow < siy.npos then siy.npos = selectrow
    if selectrow > siy.npos + pagerows then siy.npos = selectrow - pagerows + 1
    case %vk_pgup
    if selectrow = siy.npos then ' on the first visible line
    siy.npos = siy.npos - siy.npage + 1
    selectrow = siy.npos
    end if
    ' not on the first display line: then move to that.
    if selectrow > siy.npos then selectrow = siy.npos
    selectrow = max(selectrow, siy.nmin)
    case %vk_pgdn
    if selectrow = siy.npos + siy.npage - 1 then ' on the last visible line
    siy.npos = siy.npos + siy.npage - 1
    selectrow = siy.npos + siy.npage - 1
    end if
    ' not on the last display line: then move to that.
    if selectrow < siy.npos + siy.npage - 1 then selectrow = siy.npos + siy.npage - 1
    selectrow = min(selectrow, siy.nmax)
    case %vk_home : six.npos = 1: siy.npos = 1 : selectrow = 1 : selectcol = 1
    case %vk_end : six.npos = columns: siy.npos = rows : selectrow = rows : selectcol = columns
    case %vk_f8 ' function key f8: anchor focus cell to enable extended selection
    anchor = 1 : control set text hlistframe&,%extselset,"ext"
    checkmenuitem hmenuright&,2,%mf_checked
    checkmenuitem hmenuright&,4,%mf_unchecked
    case else
    end select
    ' ensure that positions are within range
    six.npos = max&(six.nmin, min&(six.npos, six.nmax - six.npage + 1))
    siy.npos = max&(siy.nmin, min&(siy.npos, siy.nmax - siy.npage + 1))
    if isfalse anchor then selectrowstart = selectrow : selectcolstart = selectcol
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    case %wm_char
    select case cbwparam
    case %vk_escape
    anchor = 0 : selectrow = selectrowstart : selectcol = selectcolstart
    control set text hlistframe&,%extselset,"
    checkmenuitem hmenuright&,4,%mf_checked
    checkmenuitem hmenuright&,2,%mf_unchecked
    call updatecolumnsandscrollbars(six.npos,siy.npos)
    end select
    end select
    ' pass the message on to the original window procedure... the ddt engine!
    function = callwindowproc(goldsubclassproc, cbhndl, cbmsg, cbwparam, cblparam)
    end function
    ' --------------------------------------------------------------------------------
    sub definecolumns(byval xpos as long)
    local lvc as lv_column
    local ztext as asciiz * 100
    local kk&
    lvc.mask = %lvcf_fmt or %lvcf_width or %lvcf_text or %lvcf_subitem
    lvc.cchtextmax = 100
    ' make the first column a 0 pixel wide empty dummy column.
    ' this prevents diplay of listview's "internal" selection cell.
    ' nb: the %lvs_ex_fullrowselect listview style should not be used.
    lvc.cx = 0
    lvc.fmt = %lvcfmt_left ' set justification
    ztext = "
    lvc.psztext = varptr(ztext)
    sendmessage hlistform&,%lvm_insertcolumn, 0, varptr(lvc)
    ' make column headers
    for kk& = xpos to xpos+pagecolumns+colextra-1 ' includes row header column
    lvc.cx = colwidth(min(kk&-1,columns))
    ztext = dataarray(min(kk&-1,columns),0)
    lvc.psztext = varptr(ztext)
    sendmessage hlistform&,%lvm_insertcolumn, kk&, varptr(lvc)
    next
    end sub
    ' --------------------------------------------------------------------------------
    sub updatecolumnsandscrollbars(byval xpos as long,byval ypos as long)
    static xprevpos as long,yprevpos as long ' previous positions (remember between calls)
    local kk&, ztext as asciiz * 100, lvc as lv_column
    lvc.mask = %lvcf_text or %lvcf_width
    lvc.cchtextmax = 100
    lvc.psztext = varptr(ztext)
    setfocus hlistform&
    '
    ' be sure that the dummy header column width is always kept at zero.
    sendmessage hlistform&,%lvm_setcolumnwidth, 0, maklng(0, 0)
    '
    if xpos<>xprevpos then ' moved in x-direction (horizontal)
    six.fmask = %sif_pos
    control send hlistframe& , %horzscrollbar, %sbm_setscrollinfo, %true, varptr(six)
    for kk& = xpos to xpos+pagecolumns+colextra
    sendmessage hlistform&, %lvm_getcolumn, kk&-xpos+2, varptr(lvc)
    lvc.cx = colwidth(kk&) : ztext = dataarray(kk&,0)
    sendmessage hlistform&,%lvm_setcolumn, kk&-xpos+2, varptr(lvc)
    next
    end if
    '
    if ypos<>yprevpos then ' moved in y-direction (vertical)
    siy.fmask = %sif_pos
    control send hlistframe&, %vertscrollbar, %sbm_setscrollinfo, %true, varptr(siy)
    end if
    ' get full selection outline.
    selymax& = max(selectrowstart, selectrow)
    selymin& = min(selectrowstart, selectrow)
    selxmax& = max(selectcolstart, selectcol)
    selxmin& = min(selectcolstart, selectcol)
    '
    invalidaterect hlistform&,byval %null,%false
    yprevpos=ypos: xprevpos=xpos ' remember new previous positions
    end sub
    ' --------------------------------------------------------------------------------
    sub makelistviewwindow(byval hlistframe&)
    local rc as rect
    '
    control add scrollbar,hlistframe&,%horzscrollbar,",0,0,0,0,%ws_child or %ws_visible or %sbs_horz
    control add scrollbar,hlistframe&,%vertscrollbar,",0,0,0,0,%ws_child or %ws_visible or %sbs_vert
    '
    ' define external horizontal scroll bar.
    six.cbsize = sizeof(six)
    six.fmask = %sif_all
    six.nmin = 1
    six.nmax = columns + colextra-1 ' some extra empty columns
    six.npage = pagecolumns
    six.npos = 1
    control send hlistframe&, %horzscrollbar, %sbm_setscrollinfo, %false, varptr(six)
    '
    ' define external vertical scroll bar.
    siy.cbsize = sizeof(siy)
    siy.fmask = %sif_all
    siy.nmin = 1
    siy.nmax = rows
    siy.npage = pagerows
    siy.npos = 1
    control send hlistframe&, %vertscrollbar, %sbm_setscrollinfo, %false, varptr(siy)

    ' make "viewport" for the listview without scroll bars to be created
    getclientrect hlistframe&, rc
    dialog new hlistframe&, ",0,0,0,0, %ws_child or %ws_visible, to hlistwindow&
    mo

  • #2
    FYO: Some improvements have been made - see above.

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

    Comment


    • #3
      Moved post to PBW forum.

      [This message has been edited by Donald Miller (edited September 14, 2005).]
      Don M. / aka thimk at thimk dot biz

      http://powerbasic.thimk.biz/

      Comment


      • #4
        Eirk, are you still around?

        The code in the first post appears to have been truncated prematurely - it ends in the middle of a word.

        Would you be able to re-post the code? I'd like to give it a try.

        Thanks,
        -John

        Comment


        • #5
          John, here it is from an old Poffs database...

          Code:
           
          #COMPILE EXE
          #REGISTER NONE
          #DIM ALL
          '
          ' In this program only listview and header controls use the COMMCTRL.INC file
          %NOANIMATE       = 1  ' Animate control.
          %NOBUTTON        = 1
          %NOCOMBO         = 1
          %NODATETIMEPICK  = 1
          %NODRAGLIST      = 1  ' APIs to make a listbox source and sink drag&drop actions.
          %NOEDIT          = 1
          %NOFLATSBAPIS    = 1
          '    %NOHEADER        = 1  ' Header bar control.
          %NOHOTKEY        = 1  ' HotKey control.
          '    %NOIMAGELIST     = 1  ' ImageList apis.
          %NOIPADDRESS     = 1
          %NOLIST          = 1
          '    %NOLISTVIEW      = 1  ' ListView control.
          %NOMENUHELP      = 1  ' APIs to help manage menus, especially with a status bar.
          %NOMONTHCAL      = 1
          %NOMUI           = 1
          %NONATIVEFONTCTL = 1
          %NOPAGESCROLLER  = 1
          %NOPROGRESS      = 1  ' Progress gas gauge.
          %NOREBAR         = 1
          %NOSTATUSBAR     = 1  ' Status bar control.
          %NOTABCONTROL    = 1
          %NOTOOLBAR       = 1  ' Customizable bitmap-button toolbar control.
          %NOTOOLTIPS      = 1
          %NOTRACKBAR      = 1  ' Customizable column-width tracking control.
          %NOTREEVIEW      = 1  ' TreeView control.
          %NOUPDOWN        = 1  ' Up and Down arrow increment/decrement control.
          '
          #INCLUDE "WIN32API.INC"
          #INCLUDE "COMMCTRL.INC"
          '
          %ListViewGrid       = 100
          %ExitButton         = 115
          %VertScrollbar      = 135
          %HorzScrollbar      = 140
          %ExtSel             = 145
          %ExtSelSet          = 150
          '
          GLOBAL hListForm&           ' Dialog handle
          GLOBAL hListFrame&          ' Dialog handle
          GLOBAL hListWindow&         ' Dialog handle
          GLOBAL Rows AS LONG         ' Total number of rows in array
          GLOBAL Columns AS LONG      ' Total number of columns in array
          GLOBAL PageRows AS LONG     ' Number of rows on a page
          GLOBAL PageColumns AS LONG  ' Number of columns on a page
          GLOBAL DataArray() AS STRING' Two-dimensional text array to be displayed
          GLOBAL ColWidth() AS LONG   ' Column width array
          GLOBAL UndoLast() AS STRING ' Two-dimensional text array to store data prior to PASTE
          GLOBAL siX AS SCROLLINFO
          GLOBAL siY AS SCROLLINFO
          GLOBAL gOldSubClassProc&
          GLOBAL SelX AS LONG         ' Column selected
          GLOBAL SelY AS LONG         ' Row selected
          GLOBAL SelectCol AS LONG
          GLOBAL SelectRow AS LONG
          GLOBAL SelectRowStart AS LONG
          GLOBAL SelectColStart AS LONG
          GLOBAL SelYMax&
          GLOBAL SelYMin&
          GLOBAL SelXMax&
          GLOBAL SelXMin&
          GLOBAL Anchor&, UndoFlag&
          GLOBAL ListviewHeaderHeight&,ListviewItemHeight&
          GLOBAL hMenuRight&
          GLOBAL ColExtra&
          ' --------------------------------------------------------------------------------
          CALLBACK FUNCTION CBF_Exit
              LOCAL res&
              res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Exit Program?")
              IF res&=%IDYES THEN DIALOG END hListFrame&
          END FUNCTION
          ' --------------------------------------------------------------------------------
          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
              hDC = GetDC(%HWND_DESKTOP)
              LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
              ReleaseDC %HWND_DESKTOP, hDC
              lfFont.lfHeight = -MulDiv(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
              FUNCTION = CreateFontIndirect (lfFont)
          END FUNCTION
          ' --------------------------------------------------------------------------------
          SUB CreateData(BYREF DataArray() AS STRING,BYREF ColWidth() AS LONG,BYREF Rows AS LONG,BYREF Columns AS LONG)
              LOCAL i&,j&
              ' Fill array with data
              FOR i&=0 TO Columns + ColExtra
                  IF i = 0 THEN ColWidth(i&) = 46 ELSE ColWidth(i&) = 150
                  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&)= "R\C"
                          ELSE     '    ' Text of row headers.
                              IF j<=Rows THEN DataArray(i&,j&)= FORMAT$(j&)
                          END IF
                      ELSE     ' i& >= 1
                          IF j&=0 THEN  ' Row zero is used for column headers.
                              IF i<= Columns THEN DataArray(i&,j&)= FORMAT$(i&)
                          ELSE ' j& >= 1  Item/subitem content
                              IF i& <= Columns AND j <= Rows THEN DataArray(i&,j&)= "Column"+STR$(i&)+" Row"+STR$(j&)
                          END IF
                      END IF
                  NEXT
              NEXT
          END SUB
          ' --------------------------------------------------------------------------------
          ' Thanks to Peter Stephensen who provided the essential features of the following three functions.
          FUNCTION SelectionToClipboard(BYREF DataArray() AS STRING, _
                                        BYVAL xMin AS LONG, BYVAL xMax AS LONG, _
                                        BYVAL yMin AS LONG, BYVAL yMax AS LONG) AS LONG
              MOUSEPTR 11
              LOCAL i AS LONG, j AS LONG
              LOCAL S AS STRING
              FOR j = yMin TO yMax
                  FOR i = xMin TO xMax
                      IF i < xMax THEN
                          S = S + DataArray(i,j) + $TAB
                      ELSE
                          S = S + DataArray(i,j) + $CRLF
                      END IF
                  NEXT
              NEXT
              LOCAL hGlob  AS LONG
              LOCAL hData  AS LONG
          '   Create a global memory object and copy the data into it
              hData = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_DDESHARE, BYVAL LEN(S)+1)
              MOUSEPTR 1
              IF ISFALSE hData THEN EXIT FUNCTION
              hGlob = GlobalLock(hData)
              IF ISFALSE hGlob THEN EXIT FUNCTION
              MoveMemory BYVAL hGlob, BYVAL STRPTR(S), BYVAL LEN(S)+1
              GlobalUnlock hData
          '   Open the clipboard
              IF ISFALSE(OpenClipboard(%NULL)) THEN GlobalFree hData : EXIT FUNCTION
          '   Paste the data into the clipboard
              IF ISFALSE(EmptyClipboard) THEN EXIT FUNCTION
              IF ISFALSE(SetClipboardData(%CF_TEXT, hData)) THEN EXIT FUNCTION
              IF ISFALSE(CloseClipboard) THEN EXIT FUNCTION
              FUNCTION = 1
          END FUNCTION
          ' --------------------------------------------------------------------------------
          FUNCTION TextFromClipboard(Txt AS STRING) AS LONG
              LOCAL hData AS ASCIIZ PTR
              IF OpenClipboard(%NULL) = 0 THEN EXIT FUNCTION
              hData = GetClipboardData (%CF_TEXT)
              CloseClipboard
              Txt = @hData
              FUNCTION = 1
          END FUNCTION
          ' --------------------------------------------------------------------------------
          FUNCTION ClipboardToGrid(BYREF DataArray() AS STRING, _
                                   BYVAL xPos AS LONG, BYVAL yPos AS LONG, _
                                   BYREF xE AS LONG,BYREF yE AS LONG) AS LONG
              LOCAL Buffer AS STRING
              LOCAL LINES AS LONG, Tabs AS LONG
              LOCAL l AS LONG, t AS LONG, InComplFlg&
              IF TextFromClipboard(Buffer) = 0 THEN EXIT FUNCTION
              MOUSEPTR 11
              LINES = PARSECOUNT(Buffer, $CRLF) - 1
              Tabs =  PARSECOUNT(PARSE$(Buffer,$CRLF,1), $TAB)
              xE = MIN(xPos+Tabs-1,Columns) : yE = MIN(yPos+LINES-1,Rows)
              '
              REDIM UndoLast(xPos TO xE,yPos TO yE)
              FOR t = 0 TO Tabs-1
                  FOR l = 0 TO LINES-1
                      IF (xPos+t) <= xE AND (yPos+l) <= yE THEN
                          ' Save data in UndoLast array before pasting
                          UndoLast(xPos+t,yPos+l) = DataArray(xPos+t,yPos+l)
                          DataArray(xPos+t,yPos+l) = PARSE$(PARSE$(Buffer,$CRLF,l+1),$TAB,t+1)
                      ELSE
                          InComplFlg& = 1
                      END IF
                  NEXT l
              NEXT t
              MOUSEPTR 1
              UndoFlag& = 1
              FUNCTION = 1
              IF InComplFlg& = 1 THEN FUNCTION = 2
          END FUNCTION
          ' --------------------------------------------------------------------------------
          FUNCTION UndoLastPaste(BYREF A AS LONG,BYREF B AS LONG,BYREF C AS LONG,BYREF D AS LONG) AS LONG
                                      'SelectColStart, SelectRowStart, SelectCol,      SelectRow
              LOCAL i&,j&
              MOUSEPTR 11
              A = LBOUND(UndoLast)    : C = UBOUND(UndoLast)
              B = LBOUND(UndoLast(2)) : D = UBOUND(UndoLast(2))
              FOR i = A TO C
                  FOR j = B TO D
                      ' Restore data prior to last paste
                      DataArray(i,j) = UndoLast(i,j)
                  NEXT
              NEXT
              MOUSEPTR 1
              UndoFlag& = 0
              FUNCTION = 1
          END FUNCTION
          ' --------------------------------------------------------------------------------
          CALLBACK FUNCTION ListViewWindowCallBack
              ' Callback Handle CBHNDL is: hListWindow&
              LOCAL rc AS RECT
              STATIC ptsCursor AS POINTAPI
              LOCAL szString AS ASCIIZ * 256
              LOCAL i&,KK&,Result&,JJ&,LL&
              LOCAL HeadNotif AS HD_NOTIFY PTR
              LOCAL LvNotMes AS NM_LISTVIEW PTR
              LOCAL pnmh AS NMHDR PTR
              LOCAL lpLVDispInfo AS LV_DISPINFO PTR
              LOCAL lplvcd AS NMLVCUSTOMDRAW PTR
              LOCAL Res&
              STATIC hFatFont&, hNormFont&, hItalFont&, hHeader&
              '
              SELECT CASE CBMSG
                  CASE %WM_INITDIALOG
                      '
                      GetClientRect CBHNDL, rc
                      hListForm& = CreateWindowEx(0, "SysListView32", BYVAL 0, _
                         %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_NOSCROLL OR %LVS_AUTOARRANGE OR %LVS_OWNERDATA,0,0, _
                         rc.nRight,rc.nBottom,CBHNDL,%ListViewGrid,GetModuleHandle(""),BYVAL 0)
                      i = SendMessage (hListForm&, %ListViewGrid, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0)
                      ' If you want gridlines, then uncomment the next line:
                      ' i = i OR %LVS_EX_GRIDLINES
                      ' NB: The %LVS_EX_FULLROWSELECT listview style should NOT be used in this program.
                      SendMessage hListForm&, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, i
                      '
                      hNormFont& = MakeFont(9,400,0,0,0,"Arial")
                      hFatFont& = MakeFont(9,700,0,0,0,"Arial")
                      hItalFont& = MakeFont(9,400,1,0,0,"Arial")
                      SendMessage hListForm&,%WM_SETFONT,hNormFont&,MAKLNG(%TRUE,0)
                      '
                      ' Set column header font
                      hHeader& = LISTVIEW_GETHEADER(hListForm&)
                      SendMessage hHeader&,%WM_SETFONT,hFatFont&,MAKLNG(%TRUE,0)
                      '
                      ' Define shortcut menu.
                      MENU NEW POPUP TO hMenuRight&
                      MENU ADD STRING, hMenuRight&,"Extended Selection OFF",4,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Extended Selection ON",2,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"-",3,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Select Full Row(s)",5,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Select Full Column(s)",10,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"-",12,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Copy Selection To Clipboard",15,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Paste From Clipboard",20,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"-",22,%MF_ENABLED
                      MENU ADD STRING, hMenuRight&,"Undo Last Paste",25,%MF_ENABLED
                      MENU ATTACH hMenuRight&, CBHNDL
                      CheckMenuItem hMenuRight&,4,%MF_CHECKED
                      '
                      ' Subclass Listview
                      gOldSubClassProc = SetWindowLong(hListForm&,%GWL_WNDPROC, CODEPTR(SubClassKeys))
                      '
                  CASE %WM_NOTIFY
                      IF LOWRD(CBWPARAM)= %ListViewGrid THEN
                              LvNotMes = CBLPARAM
                              SELECT CASE @LvNotMes.hdr.code
                                  CASE %NM_CLICK ' Left mouse button click
                                      GetCursorPos ptsCursor
                                      ScreenToClient hListForm&, ptsCursor
                                      KK& = (ptsCursor.y - ListviewHeaderHeight& - 1) \ ListviewItemHeight&
                                      IF @LvNotMes.iSubItem > 1 THEN
                                          SelectRow = KK& + siY.nPos
                                          SelectCol = MAX(siX.nPos + @LvNotMes.iSubItem - 2,1)
                                          IF ISFALSE Anchor THEN SelectRowStart = SelectRow : SelectColStart = SelectCol
                                          CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                                      END IF
                                      FUNCTION = 1 : EXIT FUNCTION
                                  CASE %NM_RCLICK ' Right mouse button click: Display shortcut menu
                                      GetCursorPos ptsCursor
                                      IF ISTRUE IsClipboardFormatAvailable(%CF_TEXT) THEN ' Can paste
                                          EnableMenuItem hMenuRight&,20,%MF_ENABLED
                                      ELSE
                                          EnableMenuItem hMenuRight&,20,%MF_GRAYED
                                      END IF
                                      IF ISTRUE UndoFlag& THEN                            ' Can undo
                                          EnableMenuItem hMenuRight&,25,%MF_ENABLED
                                      ELSE
                                          EnableMenuItem hMenuRight&,25,%MF_GRAYED
                                      END IF
                                      TrackPopupMenuEx hMenuRight&,%TPM_LEFTALIGN OR %TPM_VERTICAL OR %TPM_LEFTBUTTON OR %TPM_RIGHTBUTTON ,ptsCursor.x,ptsCursor.y,CBHNDL,BYVAL %NULL
                                  CASE %NM_CUSTOMDRAW
                                      lplvcd = CBLPARAM
                                      IF(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) THEN
                                          ' The following statement makes Windows happy:
                                          SetWindowLong hListWindow&,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW
                                          ' This statement makes the DDT engine happy:
                                          FUNCTION = 1: EXIT FUNCTION
                                      END IF
                                      IF(@lplvcd.nmcd.dwDrawStage = %CDDS_ITEMPREPAINT) THEN
                                          SetWindowLong hListWindow&,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW
                                          FUNCTION = 1: EXIT FUNCTION
                                      END IF
                                      IF(@lplvcd.nmcd.dwDrawStage = %CDDS_SUBITEM OR %CDDS_ITEMPREPAINT)  THEN
                                          IF @lplvcd.iSubItem <= 1 THEN            ' Row header (or dummy column)
                                              KK& = @lplvcd.nmcd.dwItemSpec + siY.nPos
                                              IF KK& MOD 2 = 1 THEN @lplvcd.clrTextBk = %LTGRAY ELSE @lplvcd.clrTextBk = RGB(210,210,210)
                                              @lplvcd.clrText = RGB(0,0,0)         ' black
                                              SelectObject @lplvcd.nmcd.hdc, hFatFont&
                                          ELSE
                                              KK& = @lplvcd.nmcd.dwItemSpec + siY.nPos
                                              LL& = siX.nPos + @lplvcd.iSubItem - 2
                                              IF KK = SelectRowStart AND LL = SelectColStart THEN
                                                  @lplvcd.clrTextBk = RGB(0,220,255)
                                                  @lplvcd.clrText = 0 ' black
                                              ELSEIF KK >= SelYMin& AND KK <= SelYMax& AND LL >= SelXMin& AND LL <= SelXMax& THEN
                                                  @lplvcd.clrTextBk = RGB(170,200,250)
                                                  @lplvcd.clrText = 0 ' black
                                              ELSE
                                                  IF KK& MOD 2 = 1 THEN @lplvcd.clrTextBk = RGB(200,255,255) ELSE @lplvcd.clrTextBk = RGB(255,255,255)
                                                  @lplvcd.clrText = 0 ' black
                                              END IF
                                              IF LL& MOD 2 = 1 THEN SelectObject @lplvcd.nmcd.hdc, hNormFont& ELSE SelectObject @lplvcd.nmcd.hdc, hItalFont&
                                          END IF
                                          SetWindowLong hListWindow&,%DWL_MSGRESULT,(%CDRF_NEWFONT OR %CDRF_NOTIFYSUBITEMDRAW)
                                          FUNCTION = 1: EXIT FUNCTION
                                      END IF
                                  CASE %LVN_GETDISPINFO    'Virtual ListView asks for Item text
                                      lpLVDispInfo = CBLPARAM
                                      IF (@lpLVDispInfo.item.mask AND %LVIF_TEXT) THEN
                                          ' Specify text to be used
                                          IF @lpLVDispInfo.item.iSubItem = 1 THEN ' row header
                                              szString = DataArray(0 , @lpLVDispInfo.item.iItem + siY.nPos)'+1
                                          ELSEIF @lpLVDispInfo.item.iSubItem > 1 THEN ' column 1 and beyond
                                              szString = DataArray(@lpLVDispInfo.item.iSubItem + siX.nPos - 2 , @lpLVDispInfo.item.iItem + siY.nPos)
                                          ELSE
                                              szString = ""  ' Dummy column
                                          END IF
                                          @lpLVDispInfo.item.pszText = VARPTR(szString)
                                          FUNCTION = 1: EXIT FUNCTION
                                      END IF
                                  CASE ELSE
                              END SELECT
                      END IF
                      '
                      HeadNotif = CBLPARAM
                      IF @HeadNotif.hdr.hwndFrom = hHeader& THEN
                          IF @HeadNotif.hdr.code = %HDN_ITEMCHANGED THEN
                              IF @HeadNotif.iItem = 0 THEN ' Maintain zero width of dummy column
                                  Result&=SendMessage(hListForm&,%LVM_GETCOLUMNWIDTH, 0, 0)
                                  IF Result&>0 THEN SendMessage hListForm&,%LVM_SETCOLUMNWIDTH, 0, MAKLNG(0, 0)
                              END IF
                          END IF
                      END IF
                  CASE %WM_COMMAND ' Right Click Menu
                      SELECT CASE CBWPARAM
                          CASE 2   ' Extended selection anchor ON
                              Anchor = 1
                              CheckMenuItem hMenuRight&,2,%MF_CHECKED
                              CheckMenuItem hMenuRight&,4,%MF_UNCHECKED
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,"EXT"
                          CASE 4   ' Extended selection anchor OFF
                              Anchor = 0
                              CheckMenuItem hMenuRight&,4,%MF_CHECKED
                              CheckMenuItem hMenuRight&,2,%MF_UNCHECKED
                              SelectRow = SelectRowStart : SelectCol = SelectColStart
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,""
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                          CASE 5   ' Select full row(s)
                              SelectColStart = 1 : SelectCol = Columns
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                          CASE 10  ' Select full column(s)
                              SelectRowStart = 1 : SelectRow = Rows
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                          CASE 15  ' Copy selected data to clipboard
                              Anchor = 0
                              CheckMenuItem hMenuRight&,4,%MF_CHECKED
                              CheckMenuItem hMenuRight&,2,%MF_UNCHECKED
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,""
                              Res& = SelectionToClipboard(DataArray(),SelXMin,SelXMax,SelYMin,SelYMax)
                              IF ISFALSE Res& THEN MSGBOX "Could Not Copy to Clipboard",%MB_ICONERROR,"Problem:"
                          CASE 20  ' Paste clipboard data to grid at the focused cell
                              Anchor = 0
                              CheckMenuItem hMenuRight&,4,%MF_CHECKED
                              CheckMenuItem hMenuRight&,2,%MF_UNCHECKED
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,""
                              Res& = ClipboardToGrid(DataArray(),SelectColStart,SelectRowStart,SelectCol,SelectRow)
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                              IF ISFALSE Res& THEN MSGBOX "Could Not Paste From Clipboard",%MB_ICONERROR,"Problem:"
                              IF Res& = 2 THEN MSGBOX "Not All Data In Clipboard Could Be Pasted Onto Grid Due To Insufficient Space",%MB_ICONWARNING,"Notice:"
                          CASE 25  ' Undo last paste to the grid
                              Anchor = 0
                              CheckMenuItem hMenuRight&,4,%MF_CHECKED
                              CheckMenuItem hMenuRight&,2,%MF_UNCHECKED
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,""
                              Res& = UndoLastPaste(SelectColStart,SelectRowStart,SelectCol,SelectRow)
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                      END SELECT
                  CASE %WM_DESTROY
                      DeleteObject hNormFont&
                      DeleteObject hFatFont&
                      DeleteObject hItalFont&
                      ' Important! Remove the subclassing
                      SetWindowLong hListForm&, %GWL_WNDPROC, gOldSubClassProc
                  CASE ELSE
              END SELECT
          END FUNCTION
          ' --------------------------------------------------------------------------------
          CALLBACK FUNCTION SubClassKeys
              ' Subclass callback function for processing key messages.
              SELECT CASE CBMSG
                  CASE %WM_GETDLGCODE
                      ' Specify that we want all keys available here.
                      FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
                  CASE %WM_KEYDOWN ' Keys at time of pressing
                      SELECT CASE CBWPARAM
                          CASE %VK_UP
                              IF SelectRow > 1 THEN DECR SelectRow : siY.nPos = MIN(siY.nPos,SelectRow)
                              IF SelectRow = siY.nPos - 1 THEN DECR siY.nPos
                              IF SelectRow > siY.nPos + PageRows THEN siY.nPos = SelectRow - PageRows + 1
                              IF SelectCol < siX.nPos THEN siX.nPos = SelectCol
                              IF SelectCol > siX.nPos + PageColumns THEN siX.nPos = SelectCol - PageColumns + 1
                          CASE %VK_DOWN
                              IF SelectRow < Rows THEN INCR SelectRow : siY.nPos = MIN(siY.nPos,SelectRow)
                              IF SelectRow = siY.nPos + PageRows THEN INCR siY.nPos
                              IF SelectRow > siY.nPos + PageRows THEN siY.nPos = SelectRow - PageRows + 1
                              IF SelectCol < siX.nPos THEN siX.nPos = SelectCol
                              IF SelectCol > siX.nPos + PageColumns THEN siX.nPos = SelectCol - PageColumns + 1
                          CASE %VK_LEFT
                              IF SelectCol > 1 THEN DECR SelectCol : siX.nPos = MIN(siX.nPos,SelectCol)
                              IF SelectCol = siX.nPos - 1 THEN DECR siX.nPos
                              IF SelectCol > siX.nPos + PageColumns THEN siX.nPos = SelectCol - PageColumns + 1
                              IF SelectRow < siY.nPos THEN siY.nPos = SelectRow
                              IF SelectRow > siY.nPos + PageRows THEN siY.nPos = SelectRow - PageRows + 1
                          CASE %VK_RIGHT
                              IF SelectCol < Columns THEN INCR SelectCol : siX.nPos = MIN(siX.nPos,SelectCol)
                              IF SelectCol = siX.nPos + PageColumns THEN INCR siX.nPos
                              IF SelectCol > siX.nPos + PageColumns THEN siX.nPos = SelectCol - PageColumns + 1
                              IF SelectRow < siY.nPos THEN siY.nPos = SelectRow
                              IF SelectRow > siY.nPos + PageRows THEN siY.nPos = SelectRow - PageRows + 1
                          CASE %VK_PGUP
                              IF SelectRow = siY.nPos THEN   ' On the first visible line
                                  siY.nPos = siY.nPos - siY.nPage + 1
                                  SelectRow = siY.nPos
                              END IF
                              ' Not on the first display line: then move to that.
                              IF SelectRow > siY.nPos THEN SelectRow = siY.nPos
                              SelectRow = MAX(SelectRow, siY.nMin)
                          CASE %VK_PGDN
                              IF SelectRow = siY.nPos + siY.nPage - 1 THEN ' On the last visible line
                                  siY.nPos = siY.nPos + siY.nPage - 1
                                  SelectRow = siY.nPos + siY.nPage - 1
                              END IF
                              ' Not on the last display line: then move to that.
                              IF SelectRow < siY.nPos + siY.nPage - 1 THEN SelectRow = siY.nPos + siY.nPage - 1
                              SelectRow = MIN(SelectRow, siY.nMax)
                          CASE %VK_HOME  : siX.nPos = 1: siY.nPos = 1 : SelectRow = 1 : SelectCol = 1
                          CASE %VK_END   : siX.nPos = Columns: siY.nPos = Rows : SelectRow = Rows : SelectCol = Columns
                          CASE %VK_F8    ' Function key F8: Anchor focus cell to enable extended selection
                              Anchor = 1 : CONTROL SET TEXT hListFrame&,%ExtSelSet,"EXT"
                              CheckMenuItem hMenuRight&,2,%MF_CHECKED
                              CheckMenuItem hMenuRight&,4,%MF_UNCHECKED
                          CASE ELSE
                      END SELECT
                      ' Ensure that positions are within range
                      siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                      siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                      IF ISFALSE Anchor THEN SelectRowStart = SelectRow : SelectColStart = SelectCol
                      CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                  CASE %WM_CHAR
                      SELECT CASE CBWPARAM
                          CASE %VK_ESCAPE
                              Anchor = 0 : SelectRow = SelectRowStart : SelectCol = SelectColStart
                              CONTROL SET TEXT hListFrame&,%ExtSelSet,""
                              CheckMenuItem hMenuRight&,4,%MF_CHECKED
                              CheckMenuItem hMenuRight&,2,%MF_UNCHECKED
                              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
                      END SELECT
              END SELECT
              ' Pass the message on to the original window procedure... the DDT engine!
              FUNCTION = CallWindowProc(gOldSubClassProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
          END FUNCTION
          ' --------------------------------------------------------------------------------
          SUB DefineColumns(BYVAL xPos AS LONG)
              LOCAL lvc AS LV_COLUMN
              LOCAL zText AS ASCIIZ * 100
              LOCAL KK&
              lvc.mask = %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM
              lvc.cchTextMax = 100
              ' Make the first column a 0 pixel wide empty DUMMY column.
              ' This prevents diplay of listview's "internal" selection cell.
              ' NB: The %LVS_EX_FULLROWSELECT listview style should NOT be used.
              lvc.cx = 0
              lvc.fmt = %LVCFMT_LEFT ' set justification
              zText = ""
              Lvc.pszText = VARPTR(zText)
              SendMessage hListForm&,%LVM_INSERTCOLUMN, 0, VARPTR(lvc)
              ' Make column headers
              FOR KK& = xPos TO xPos+PageColumns+ColExtra-1 ' includes row header column
                  lvc.cx = ColWidth(MIN(KK&-1,Columns))
                  zText = DataArray(MIN(KK&-1,Columns),0)
                  lvc.pszText = VARPTR(zText)
                  SendMessage hListForm&,%LVM_INSERTCOLUMN, KK&, VARPTR(lvc)
              NEXT
          END SUB
          ' --------------------------------------------------------------------------------
          SUB UpdateColumnsAndScrollbars(BYVAL xPos AS LONG,BYVAL yPos AS LONG)
              STATIC xPrevPos AS LONG,yPrevPos AS LONG  ' previous positions (remember between calls)
              LOCAL KK&, zText AS ASCIIZ * 100, lvc AS LV_COLUMN
              lvc.mask = %LVCF_TEXT OR %LVCF_WIDTH
              lvc.cchTextMax = 100
              lvc.pszText = VARPTR(zText)
              SetFocus hListForm&
              '
              ' Be sure that the dummy header column width is always kept at zero.
              SendMessage hListForm&,%LVM_SETCOLUMNWIDTH, 0, MAKLNG(0, 0)
              '
              IF xPos<>xPrevPos THEN ' Moved in X-direction (horizontal)
                  siX.fMask = %SIF_POS
                  CONTROL SEND hListFrame& , %HorzScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siX)
                  FOR KK& = xPos TO xPos+PageColumns+ColExtra
                      SendMessage hListForm&, %LVM_GETCOLUMN, KK&-xPos+2, VARPTR(lvc)
                      lvc.cx = ColWidth(KK&) : zText = DataArray(KK&,0)
                      SendMessage hListForm&,%LVM_SETCOLUMN, KK&-xPos+2, VARPTR(lvc)
                  NEXT
              END IF
              '
              IF yPos<>yPrevPos THEN ' Moved in Y-direction (vertical)
                  siY.fMask = %SIF_POS
                  CONTROL SEND hListFrame&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
              END IF
              ' Get full selection outline.
              SelYMax& = MAX(SelectRowStart, SelectRow)
              SelYMin& = MIN(SelectRowStart, SelectRow)
              SelXMax& = MAX(SelectColStart, SelectCol)
              SelXMin& = MIN(SelectColStart, SelectCol)
              '
              InvalidateRect hListForm&,BYVAL %NULL,%FALSE
              yPrevPos=yPos: xPrevPos=xPos ' Remember new previous positions
          END SUB
          ' --------------------------------------------------------------------------------
          SUB MakeListviewWindow(BYVAL hListFrame&)
              LOCAL rc AS RECT
              '
              CONTROL ADD SCROLLBAR,hListFrame&,%HorzScrollbar,"",0,0,0,0,%WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
              CONTROL ADD SCROLLBAR,hListFrame&,%VertScrollbar,"",0,0,0,0,%WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
              '
              ' Define external horizontal scroll bar.
              siX.cbSize = SIZEOF(siX)
              siX.fMask  = %SIF_ALL
              siX.nMin   = 1
              siX.nMax   = Columns + ColExtra-1 ' Some extra empty columns
              siX.nPage  = PageColumns
              siX.nPos   = 1
              CONTROL SEND hListFrame&, %HorzScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siX)
              '
              ' Define external vertical scroll bar.
              siY.cbSize = SIZEOF(siY)
              siY.fMask  = %SIF_ALL
              siY.nMin   = 1
              siY.nMax   = Rows
              siY.nPage  = PageRows
              siY.nPos   = 1
              CONTROL SEND hListFrame&, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
          
              ' Make "viewport" for the listview without scroll bars to be created
              GetClientRect hListFrame&, rc
              DIALOG NEW hListFrame&, "",0,0,0,0, %WS_CHILD OR %WS_VISIBLE, TO hListWindow&
              MoveWindow hListWindow&,5,5,rc.nRight-10-GetSystemMetrics(%SM_CXVSCROLL),rc.nBottom-40-GetSystemMetrics(%SM_CYHSCROLL),%TRUE
              '
              ' Make this dialog modeless
              DIALOG SHOW MODELESS hListWindow& CALL ListViewWindowCallBack
              '
              ' Dimension listview to avoid clipping of last displayed item.
              LOCAL hHead&,Res2&,H&,W&
              GetWindowRect hListForm&, rc
              H& = rc.nBottom - rc.nTop : W& = rc.nRight - rc.nLeft
              '
              LOCAL CN&,I&
              FOR I = 0 TO Columns
                  CN&=CN&+ColWidth(I)
                  IF CN& > W& THEN PageColumns = I-1 : EXIT FOR ' Number of columns in a displayed page
              NEXT
              '
              ' Define columns in listview
              CALL DefineColumns(siX.nPos)
              '
              hHead& = SendMessage(hListForm&,%LVM_GETHEADER,0,0) ' header handle
              Res2& = SendMessage(hHead&, %HDM_GETITEMRECT, 0, VARPTR(rc))
              ListviewHeaderHeight& = rc.nBottom - rc.nTop   ' Height in pixels of listview header
              '
              ' Set one test item to allow determination of item height in listview.
              LOCAL lvi AS LV_ITEM
              LOCAL zText AS ASCIIZ * 100
              lvi.mask = %LVIF_TEXT
              lvi.pszText = VARPTR(zText)
              lvi.iItem = 0             '
              zText=" "
              LISTVIEW_INSERTITEM hListForm&, lvi
              '
              rc.nLeft = %LVIR_LABEL
              Res2& = SendMessage(hListForm&,%LVM_GETITEMRECT, 0, VARPTR(rc))
              ListviewItemHeight& = rc.nBottom - rc.nTop + 2   ' Height in pixels of one line in listview
              '                                                  Add a few pixels as extra space
              '
              LOCAL hImg&
              ' Set new ListviewItemHeight. Thanks to Edwin Knoppert for this elegant technique.
              ' Since the procedure below sets the item height one higher than specified
              ' to provide a one pixel wide space (the grid line - if any) between images,
              ' we subtract this one pixel.
              hImg = ImageList_Create(1, ListviewItemHeight&-1, %ILC_COLORDDB, 0, 0)
              LISTVIEW_SETIMAGELIST hListForm&, BYVAL hImg, %LVSIL_SMALL
              '
              H = (H - ListviewHeaderHeight&) \ ListviewItemHeight& ' Number of unclipped displayed items.
              '
              PageRows = H ' Number of rows in a displayed page
              '
              ' Set initial cursor position
              SelectCol = siX.nPos
              SelectRow = siY.nPos
              SelectRowStart = SelectRow : SelectColStart = SelectCol
              SelYMax& = SelectRow : SelYMin& = SelectRow
              SelXMax& = SelectCol : SelXMin& = SelectCol
              '
              H = H * ListviewItemHeight& + ListviewHeaderHeight& + 2 ' adjusted listview height
              MoveWindow hListForm&,0,0,W,H,%TRUE
              MoveWindow hListWindow&,5,5,W,H,%TRUE
              LISTVIEW_DELETEALLITEMS hListForm&
              '
              GetClientRect hHead&, rc
              ' Increase height of header to cover blank part of upper line (Fault of listview ?)
              MoveWindow hHead&,rc.nLeft,rc.nTop,rc.nRight-rc.nLeft,rc.nBottom-rc.nTop+2,%TRUE
              '
              ' Set number of items corresponding to one displayed page.
              LISTVIEW_SETITEMCOUNTEX hListForm&,PageRows,%LVSICF_NOINVALIDATEALL
              '
              siX.nPage  = PageColumns
              CONTROL SEND hListFrame&, %HorzScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siX)
              siY.nPage  = PageRows
              CONTROL SEND hListFrame&, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
              '
              ' Move external scroll bars to borders of listview frame.
              MoveWindow GetDlgItem(hListFrame&,%VertScrollbar),5+W,5,GetSystemMetrics(%SM_CXVSCROLL),H, %TRUE
              MoveWindow GetDlgItem(hListFrame&,%HorzScrollbar),5,5+H,W,GetSystemMetrics(%SM_CYHSCROLL), %TRUE
              SetFocus hListForm&
          END SUB
          ' --------------------------------------------------------------------------------
          SUB ListViewVertScroll(BYVAL hListFrame&,BYVAL ScrollMes&)
              SELECT CASE ScrollMes&     ' LOWRD(CBWPARAM)
                  CASE %SB_LINEDOWN      : INCR siY.nPos
                  CASE %SB_PAGEDOWN      : siY.nPos = siY.nPos + siY.nPage - 1
                  CASE %SB_LINEUP        : DECR siY.nPos
                  CASE %SB_PAGEUP        : siY.nPos = siY.nPos - siY.nPage + 1
                  CASE %SB_THUMBPOSITION ,%SB_THUMBTRACK'
                      siY.cbSize = SIZEOF(siY)
                      siY.fMask  = %SIF_TRACKPOS
                      CONTROL SEND hListFrame&, %VertScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siY)
                      siY.nPos   = siY.nTrackPos
                  CASE ELSE              : EXIT SUB
              END SELECT
              ' Ensure that position is within range
              siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
          END SUB
          ' --------------------------------------------------------------------------------
          SUB ListViewHorzScroll(BYVAL hListFrame&,BYVAL ScrollMes&)
              SELECT CASE ScrollMes&     ' LOWRD(CBWPARAM)
                  CASE %SB_LINERIGHT     : INCR siX.nPos
                  CASE %SB_PAGERIGHT     : siX.nPos = siX.nPos + siX.nPage - 1
                  CASE %SB_LINELEFT      : DECR siX.nPos
                  CASE %SB_PAGELEFT      : siX.nPos = siX.nPos - siX.nPage + 1
                  CASE %SB_THUMBPOSITION ,%SB_THUMBTRACK
                      siX.cbSize = SIZEOF(siX)
                      siX.fMask  = %SIF_TRACKPOS
                      CONTROL SEND hListFrame&, %HorzScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siX)
                      siX.nPos   = siX.nTrackPos
                  CASE ELSE              : EXIT SUB
              END SELECT
              ' Ensure that position is within range
              siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
              CALL UpdateColumnsAndScrollbars(siX.nPos,siY.nPos)
          END SUB
          ' --------------------------------------------------------------------------------
          ' ---------------Main program part------------------------------------------------
          ' --------------------------------------------------------------------------------
          ' --------------------------------------------------------------------------------
          CALLBACK FUNCTION ListFrameCallBack
              ' CBHNDL = hListFrame&
              SELECT CASE CBMSG
                  CASE %WM_INITDIALOG
                      CALL MakeListviewWindow(CBHNDL)
                      FUNCTION = 1 : EXIT FUNCTION
                  CASE %WM_VSCROLL
                      IF CBLPARAM = GetDlgItem(CBHNDL,%VertScrollbar) THEN
                          CALL ListViewVertScroll(CBHNDL,LOWRD(CBWPARAM))
                          FUNCTION = 1 : EXIT FUNCTION
                      END IF
                  CASE %WM_HSCROLL
                      IF CBLPARAM = GetDlgItem(CBHNDL,%HorzScrollbar) THEN
                          CALL ListViewHorzScroll(CBHNDL,LOWRD(CBWPARAM))
                          FUNCTION = 1 : EXIT FUNCTION
                      END IF
              END SELECT
          END FUNCTION
          ' --------------------------------------------------------------------------------
          FUNCTION PBMAIN
              LOCAL rc AS RECT
              LOCAL Style&,Marg&
              LOCAL CC1 AS INIT_COMMON_CONTROLSEX
              CC1.dwSize=SIZEOF(CC1)
              CC1.dwICC=%ICC_WIN95_CLASSES
              InitCommonControlsEx CC1
              '
              Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
              DIALOG NEW 0, "Virtual Custom Drawn ListView Grid Control With Full Selection Capability", 0,0,0,0, Style&, 0 TO hListFrame&
              '
              SystemParametersInfo %SPI_GETWORKAREA,BYVAL 0, BYVAL VARPTR(Rc),BYVAL 0
              Marg& = 7
              MoveWindow hListFrame&,rc.nLeft+Marg&,rc.nTop+Marg&,rc.nRight-2*Marg&,rc.nBottom-2*Marg&, %TRUE
              '
              CONTROL ADD BUTTON,hListFrame&,%ExitButton,"E&xit",0,0,0,0,%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Exit
              GetClientRect hListFrame&, rc
              MoveWindow GetDlgItem(hListFrame&,%ExitButton),rc.nRight-100,rc.nBottom-26,95,21,%TRUE
              '
              CONTROL ADD LABEL,hListFrame&,%ExtSel,"F8: Extend Selection - Esc: Abolish",0,0,0,0,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
              MoveWindow GetDlgItem(hListFrame&,%ExtSel),rc.nRight\2-200,rc.nBottom-23,400,15,%TRUE
              CONTROL ADD LABEL,hListFrame&,%ExtSelSet,"",0,0,0,0,%WS_CHILD OR %WS_VISIBLE
              MoveWindow GetDlgItem(hListFrame&,%ExtSelSet),rc.nRight-200,rc.nBottom-23,33,18,%TRUE
              '
              ' Specification of size of array.
              Columns = 15 : Rows = 100 : ColExtra = 3
              Columns = MAX(8,Columns)
              Rows = MAX(26,Rows)
              ' some extra space is being added.
              REDIM DataArray(0:Columns+ColExtra,0:Rows+2)' Column zero and row zero are used for headers.
              REDIM ColWidth(0:Columns+ColExtra) ' Each column may have varying width, but horizontal scrolling will be poorer.
              CALL CreateData(DataArray(),ColWidth(),Rows,Columns)
              '
              DIALOG SHOW MODAL hListFrame& CALL ListFrameCallBack
              ' Handle of main window is: hListFrame&
          END FUNCTION

          Comment


          • #6
            Thanks, Pierre! Really appreciate it!
            -John

            Comment

            Working...
            X