Synchronized Scrolling V - Virtual

Category: Controls - ListView

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Option AnsiApi
#Debug Error On
#Debug Display On
#Include "Win32Api.inc"
 
%Checkbox       = 200
%IDC_ListViewL  = 201
%IDC_ListViewR  = 202
%IDM_LeftOne    = 203
%IDM_LeftTwo    = 204
%IDM_RightOne   = 205
%IDM_RightTwo   = 206
 
Global hDlg, hListviewLeft, hListviewRight, OrigProc As Dword
Global Delta As Long, DataLeft(), DataRight() As String
Global hContextMenuLeft, hContextMenuRight As Dword
 
Function PBMain() As Long
   Dialog New Pixels, %HWND_Desktop, "ListView syncro", , , 230, 230, %WS_OverlappedWindow, 0 To hDlg
   Control Add CheckBox, hDlg, %Checkbox, "Synchronized Scrolling", 50, 10, 170, 20
   Control Set Check hDlg, %Checkbox, %TRUE
   CreateListViews
   CreateContextMenus
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y,iResult,Row,Col As Long, pLVDI As LV_DispInfo Ptr, temp$
   Select Case CbMsg
      Case %WM_InitDialog
         OrigProc = SetWindowLong(hListviewLeft, %GWL_WNDPROC, CodePtr(ListviewProc))
         SetWindowLong(hListviewRight, %GWL_WNDPROC, CodePtr(ListviewProc))
      Case %WM_Command
         Select Case CB.Ctl
            Case %IDM_LeftOne  : ? "Menu Left-One"
            Case %IDM_LeftTwo  : ? "Menu Left-Two"
            Case %IDM_RightOne : ? "Menu Right-One"
            Case %IDM_RightTwo : ? "Menu Right-One"
         End Select
      Case %WM_ContextMenu
         x = Lo(Integer,Cb.LParam) : y = Hi(Integer, Cb.LParam)
         Select Case GetDlgCtrlID (Cb.WParam)
            Case %IDC_ListViewL
               TrackPopupMenu hContextMenuLeft, %TPM_LeftAlign, x, y, 0, Cb.Hndl, ByVal 0
            Case %IDC_ListViewR
               TrackPopupMenu hContextMenuRight, %TPM_LeftAlign, x, y, 0, Cb.Hndl, ByVal 0
         End Select
      Case %WM_Notify
         Select Case Cb.NmId
            Case %IDC_ListViewL
               Select Case Cb.NmCode
                  Case %LVN_GetDispInfo             'notification to ask for data
                     pLVDI = Cb.LParam               'pointer to LVDISPINFO structure for requested subitem
                     Row = @pLVDI.item.iItem         'row being asked for
                     temp$ = DataLeft(Row)
                     @pLVDI.item.pszText = StrPtr(temp$) 'text sent to ListView
                  Case %NM_DblClk
                     ListView Get Select hDlg, %IDC_ListViewL To iResult
                     ? "Left side double click on row " + Str$(iResult)
               End Select
            Case %IDC_ListViewR
               Select Case Cb.NmCode
                  Case %LVN_GetDispInfo             'notification to ask for data
                     pLVDI = Cb.LParam               'pointer to LVDISPINFO structure for requested subitem
                     Row = @pLVDI.item.iItem         'row being asked for
                     temp$ = DataRight(Row)
                     @pLVDI.item.pszText = StrPtr(temp$) 'text sent to ListView
                  Case %NM_DblClk
                     ListView Get Select hDlg, %IDC_ListViewR To iResult
                     ? "Right side double click on row " + Str$(iResult)
               End Select
         End Select
 
      Case %WM_APP
         SetTopIndex(Cb.LParam, GetScrollPos(Cb.WParam, %SB_Vert)-Delta)
 
      Case %WM_Destroy
         SetWindowLong(hListviewLeft,  %GWL_WNDPROC, OrigProc)
         SetWindowLong(hListviewRight, %GWL_WNDPROC, OrigProc)
   End Select
End Function
 
Sub CreateListViews
   Local i,iMax As Long
   Control Add ListView, hDlg, %IDC_ListViewL, "", 10,40,100,180, %WS_Child Or %WS_TabStop Or %WS_Visible Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData
   Control Handle hDlg, %IDC_ListViewL To hListviewLeft
   ListView Insert Column hDlg, %IDC_ListViewL, 1, "Data", 80, 0
 
   Control Add ListView, hDlg, %IDC_ListViewR, "", 120,40,100,180, %WS_Child Or %WS_TabStop Or %WS_Visible Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData
   Control Handle hDlg, %IDC_ListViewR To hListviewRight
   ListView Insert Column hDlg, %IDC_ListViewR, 1, "Data", 80, 0
 
   SendMessage (hListViewLeft, %WM_NOTIFYFORMAT, hDlg, %NF_REQUERY)
   SendMessage (hListViewRight, %WM_NOTIFYFORMAT, hDlg, %NF_REQUERY)
 
   iMax = 100000
   ReDim DataLeft(iMax), DataRight(iMax)
   For i = 0 To iMax
      DataLeft(iMax-i) = Str$(iMax-i+1)
      DataRight(iMax-i) = Str$(iMax-i+1)
   Next i
 
   ListView_SetItemCountEx(hListViewLeft, iMax, %LVSICF_noInvalidateAll) 'max rows
   ListView_SetItemCountEx(hListViewRight, iMax, %LVSICF_noInvalidateAll) 'max rows
 
End Sub
 
Sub CreateContextMenus
   'Left
   Menu New PopUp To hContextMenuLeft
   Menu Add String, hContextMenuLeft, "One",  %IDM_LeftOne,  %MF_Enabled
   Menu Add String, hContextMenuLeft, "Two",  %IDM_LeftTwo,  %MF_Enabled
   'Right
   Menu New PopUp To hContextMenuRight
   Menu Add String, hContextMenuRight, "One",  %IDM_RightOne,  %MF_Enabled
   Menu Add String, hContextMenuRight, "Two",  %IDM_RightTwo,  %MF_Enabled
End Sub
 
Function SetTopIndex(hListview As Dword, index As LongAs Long
   Local rc As RECT
   SendMessage(hListview, %LVM_GetItemRect, 0, VarPtr(rc))
   SendMessage(hListView, %LVM_Scroll, 0, (index - GetScrollPos(hListview, %SB_Vert)) * (rc.nBottom - rc.nTop))
End Function
 
Function ListviewProc(ByVal hWnd As Dword, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Local iResult As Long
   Select Case Msg
      Case %WM_VScroll, %WM_KeyFirst To %WM_KeyLast, %WM_MouseWheel
         Control Get Check hDlg, %CheckBox To iResult : If iResult = 0 Then Exit Select
         If (hWnd = hListviewLeft) Then
            Delta = GetScrollPos(hListViewLeft, %SB_Vert) - GetScrollPos(hListViewRight, %SB_Vert)
            PostMessage(hDlg, %WM_APP, hListviewLeft, hListviewRight)
         ElseIf (hWnd = hListviewRight) Then
            Delta = GetScrollPos(hListViewRight, %SB_Vert) - GetScrollPos(hListViewLeft, %SB_Vert)
            PostMessage(hDlg, %WM_APP, hListviewRight, hListviewLeft)
         End If
   End Select
   Function = CallWindowProc(OrigProc, hWnd, MsgwParamlParam)
End Function
 
'gbs_01130
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm