Synchronized Scrolling II - Pierre

Date: 02-16-2022

Return to Index

 
'Credit: Pierre Bellisle
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
%IDC_ListViewL = 500 :  %IDC_ListViewR = 501
Global hDlg,hLeft,hRight As Dword, OrigProc As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "ListView Test",300,300,230,200,%WS_OverlappedWindow, 0 To hDlg
   CreateListViews
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         OrigProc = SetWindowLong(hLeft,%GWL_WNDPROC, CodePtr(NewProc))
         SetWindowLong(hRight,%GWL_WNDPROC, CodePtr(NewProc)) '<--- no need to capture return value
      Case %WM_Destroy
         SetWindowLong hLeft, %GWL_WNDPROC, OrigProc
         SetWindowLong hRight, %GWL_WNDPROC, OrigProc
      Case %WM_App
         SetTopItem Cb.LParam, GetScrollPos(Cb.WParam, %SB_Vert)
   End Select
End Function
 
Sub CreateListViews
   Local i As Long
   Control Add ListView, hDlg, %IDC_ListViewL, "", 10,10,100,180
   Control Add ListView, hDlg, %IDC_ListViewR, "", 120,10,100,180
   Control Handle hDlg, %IDC_ListViewL To hLeft
   Control Handle hDlg, %IDC_ListViewR To hRight
   ListView Insert Column hDlg, %IDC_ListViewL, 1, "Left", 80, 0
   ListView Insert Column hDlg, %IDC_ListViewR, 1, "Right", 80, 0
   For i = 1 To 100
      ListView Insert Item hDlg, %IDC_ListViewL, 1, 0, Str$(i)
      ListView Insert Item hDlg, %IDC_ListViewR, 1, 0, Str$(i)
   Next i
End Sub
 
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case Msg
      Case %WM_VScroll, %WM_KEYFIRST To %WM_KEYLAST
         PostMessage hDlg, %WM_App,IIf(hWnd=hLeft,hLeft,hRight),IIf(hWnd=hLeft,hRight,hLeft)
   End Select
   Function = CallWindowProc(OrigProc, hWnd, Msg, wParam, lParam)
End Function
 
Function SetTopItem(hListview As Dword, index As Long) As Long
   Local ListviewItemRect As RECT, ListviewPixelItemHeight, ListviewPixelScrollPosY As Long
   SendMessage(hListview, %LVM_GetItemRect, 0, VarPtr(ListviewItemRect))
   ListviewPixelItemHeight = ListviewItemRect.nBottom - ListviewItemRect.nTop
   ListviewPixelScrollPosY = GetScrollPos(hListview, %SB_Vert) * ListviewPixelItemHeight
   SendMessage(hListView, %LVM_Scroll, 0, index * ListviewPixelItemHeight - ListviewPixelScrollPosY)
End Function
 
'gbs_01127
'Date: 03-10-2012

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