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

Listview with frozen column

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

  • Listview with frozen column

    This is an attempt to show a listview with a column that is fozen. The purpose is to have a list that can be scrolled horizontally and vertically, but the first column needs to be scrolled only vertically.
    Code:
    '______________________________________________________________________________
    '
    ' ListView with "frozen" first column sample
    ' Bill Scharf, 6/2008
    ' ------------------------
    '
    'Much(most) credit is due to others
    'Erik Christensen and a discussion by him
    '   http://www.powerbasic.com/support/pbforums/showthread.php?t=24702
    '   http://www.powerbasic.com/support/pbforums/showthread.php?t=12258
    '   this helps to understand the method of scrolling using RECTs
    '   other methods of scrolling I tried seemed buggy or overly complicated
    '
    'Erik Christensen and Semen Matusovski for methods of hiding LV scroll bars
    '   http://www.powerbasic.com/support/pbforums/showthread.php?t=4441
    '
    'Kev Peel's example of a parallel listivew
    '   http://www.powerbasic.com/support/pbforums/showthread.php?t=12896
    '   I started with Kev's example, so much of the code is his
    '
    'And yes, there is a .net control that does this (and probably better), but
    '.net framwork is not something we want to be tied to distributing to everybody
    '______________________________________________________________________________
    
    #COMPILE EXE
    #DIM ALL
    #REGISTER ALL
    
    %USEMACROS = 1
    #INCLUDE "WIN32API.INC"
    #INCLUDE "COMMCTRL.INC"
    
    %ID_LVA_LV          = 100       ' Main listview identifier #1
    %ID_LVB_LV          = 200       ' Main listview identifier #2
    GLOBAL hDlg, hDlgLv AS DWORD
    GLOBAL h1, h2 AS LONG
    
    '------------------------------------------------------------------------------
    ' Listview Subclass Procedure
    ' This subclass callback is for both listivews, despite the fact that they have
    '      two different parent dialogs.
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ListView_SubclassProc
      STATIC sbUpdating AS BYTE
      STATIC ControlID, secondaryID, ControlHdlg, SecondaryHDLG, hctl, hctl2 AS LONG
      LOCAL i AS LONG
      LOCAL ms_lvi AS LV_ITEM
    
      SELECT CASE CBMSG
    
             CASE %WM_VSCROLL, %WM_MOUSEWHEEL , %WM_KEYFIRST TO %WM_KEYLAST, %WM_MOUSEFIRST TO %WM_MOUSELAST'Note HSCROLL is not needed
                        'the left ListView should not be allowed to scroll right
                        IF CBMSG = %WM_KEYDOWN AND CBWPARAM = %VK_RIGHT AND GetDlgCtrlID(CBHNDL) = %ID_LVA_LV THEN'
                            EXIT FUNCTION
                        END IF
                        ControlID   =IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, %ID_LVA_LV, %ID_LVB_LV)
                        secondaryID = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, %ID_LVB_LV, %ID_LVA_LV)
                        ControlHdlg = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, hDlgLv, hdlg)
                        SecondaryHDLG =  IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVB_LV, hDlgLv, hdlg)
                        'post a custom message.  THis allows all the scrolling to complete
                        'without this, the scrolling will trigger before it is complete and you might be off by 1 row
                        PostMessage CBHNDL, %WM_USER + 401, 0, 0
    
             CASE %WM_USER + 401
                 LOCAL rc1 AS RECT, rc2 AS RECT
                 rc1.nLeft = %LVIR_BOUNDS
                 CONTROL HANDLE ControlHdlg, ControlID TO hctl
                 CONTROL HANDLE SecondaryHDLG, secondaryID TO hctl2
                 'find how far down the initiating control is scrolled
                 SendMessage hctl, %LVM_GETITEMRECT, 0, VARPTR(rc1)
                 'find how far down the secondary control is
                 rc2.nLeft = %LVIR_BOUNDS
                 i=SendDlgItemMessage (SecondaryHDLG,secondaryID,%LVM_GETITEMRECT, 0, VARPTR(rc2))
                 'scrolling the secondary control to where the initiating control is
                 i=SendDlgItemMessage (SecondaryHDLG, secondaryID, %LVM_SCROLL, 0,rc2.nTop - rc1.nTop)
                 'get the selected one from the initiating control and select the same one in the secondary control
                  i=ListView_GetNextItem(hctl, -1, %LVNI_FOCUSED OR %LVNI_SELECTED)
                  IF i > -1 THEN'select the other one
                                ms_lvi.stateMask = %LVIS_FOCUSED OR %LVIS_SELECTED
                                ms_lvi.state = %LVIS_FOCUSED OR %LVIS_SELECTED
                                SendMessage hctl2, %LVM_SETITEMSTATE, -1, VARPTR(ms_lvi)
                                SendMessage hctl2, %LVM_SETITEMSTATE, i, VARPTR(ms_lvi)
                  END IF
    
             CASE %WM_DESTROY
                  FUNCTION = CallWindowProc(GetWindowLong(CBHNDL, %GWL_USERDATA), CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
                  SetWindowLong CBHNDL, %GWL_WNDPROC, GetWindowLong(CBHNDL, %GWL_USERDATA)
                  EXIT FUNCTION
    
      END SELECT
    
      FUNCTION = CallWindowProc(GetWindowLong(CBHNDL, %GWL_USERDATA), CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    ' Main dialog callback procedure
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION dlgMain
      LOCAL i AS LONG, lvi AS LV_ITEM, lvc AS LV_COLUMN, zText AS ASCIIZ * 1024, rc AS RECT
    
      SELECT CASE CBMSG
    
             CASE %WM_INITDIALOG
                  ' Prepare example listview items...
                  lvi.mask    = %LVIF_TEXT
                  lvi.pszText = VARPTR(zText)
                  FOR i = 1 TO 24
                      lvi.iItem = i-1
                      zText     = STR$(i)+":00 " + "Appointment"
                      CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTITEM, 0, VARPTR(lvi)
                      zText     = STR$(i)+":00"
                      CONTROL SEND hDlgLv, %ID_LVA_LV, %LVM_INSERTITEM, 0, VARPTR(lvi)
                  NEXT i
                ' Set column info...
                  GetClientRect GetDlgItem(CBHNDL, %ID_LVb_LV), rc
                  zText       = "Employee2"
                  lvc.mask    = %LVCF_WIDTH OR %LVCF_TEXT
                  lvc.pszText = VARPTR(zText)
                  lvc.cx      = rc.nRight-2
                  CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                  zText       = "Employee1"
                  CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                  zText       = "Time"
                  CONTROL SEND hDlgLv, %ID_LVA_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                   FOR i = 0 TO 24
                         ztext = "Another appt at" + STR$(i+1) + ":00"
                         ListView_SetitemText(h1, i, 1, ztext)
                   NEXT i
                  ' Subclass listviews
                  SetWindowLong GetDlgItem(hDlgLv, %ID_LVA_LV), %GWL_USERDATA, SetWindowLong(GetDlgItem(hDlgLv, %ID_LVA_LV), %GWL_WNDPROC, CODEPTR(ListView_SubclassProc))
                  SetWindowLong GetDlgItem(CBHNDL, %ID_LVB_LV), %GWL_USERDATA, SetWindowLong(GetDlgItem(CBHNDL, %ID_LVB_LV), %GWL_WNDPROC, CODEPTR(ListView_SubclassProc))
    
             CASE %WM_COMMAND
                  ' Exit program...
                  IF (CBCTL = %IDOK) AND (CBCTLMSG = %BN_CLICKED) THEN DIALOG END CBHNDL
    
      END SELECT
    
    END FUNCTION
    '------------------------------------------------------------------------------
    ' Secondary callback procedure
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION dlgMain2
          'subclassing this dialog's ListView could go here if you wanted...but why not put them in the same place
    END FUNCTION
    
    '------------------------------------------------------------------------------
    ' Program Start Point
    '------------------------------------------------------------------------------
    
    
    FUNCTION PBMAIN
      LOCAL lStyle AS LONG
      DIALOG NEW 0, "Parallel ListView Test", , , 250, 153, %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_POPUP TO hDlg
      DIALOG NEW hDlg, "", 0, 0, 65-2, 130-3-10, %WS_CHILD OR %WS_VISIBLE TO hDlgLv
    
      CONTROL ADD $WC_LISTVIEW, hDlgLv, %ID_LVA_LV, "", 0, 0, 75, 135,  %WS_CHILD OR %WS_VISIBLE OR _
                    %WS_TABSTOP OR %LVS_REPORT OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_LEFT OR _
                    %WS_EX_CLIENTEDGE OR %WS_EX_RIGHTSCROLLBAR
      CONTROL ADD $WC_LISTVIEW, hDlg, %ID_LVB_LV, "", 64, 0, 125, 129,  %WS_CHILD OR %WS_VISIBLE OR _
                    %WS_TABSTOP OR %LVS_REPORT OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_LEFT OR _
                    %WS_EX_CLIENTEDGE OR %WS_EX_RIGHTSCROLLBAR
      CONTROL HANDLE hDlgLv, %ID_LVa_LV TO h2
      CONTROL HANDLE hDlg, %ID_LVb_LV TO h1
      CONTROL ADD BUTTON, hDlg, %IDOK, "Exit", 100, 135, 50, 15
      'The listviews lack style...so let's add styles
      '  This is done separately and after all controls are added just so I could play around with various styles
        lStyle = ListView_GetExtendedListViewStyle(h2)
        ListView_SetExtendedListViewStyle(h2, lStyle OR %LVS_EX_FULLROWSELECT _
            OR %LVS_EX_GRIDLINES)
        lStyle = ListView_GetExtendedListViewStyle(h1)
        ListView_SetExtendedListViewStyle(h1, lStyle OR %LVS_EX_FULLROWSELECT _
            OR %LVS_EX_GRIDLINES)
    
      DIALOG SHOW MODELESS hDlgLv CALL dlgMain2
      DIALOG SHOW MODAL hDlg CALL dlgMain
    END FUNCTION
    Last edited by Bill Scharf; 5 Jun 2008, 03:14 PM. Reason: typos
    Bill Scharf
Working...
X