Tweet
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