Synchronized Scrolling IV - More DDT

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE "pierre_modified.exe"
#Dim All
%Unicode=1
#Include "Win32Api.inc"
#Include "CommCtrl.inc"
 
%Checkbox       = 101
%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, Delta As Long
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 as Long
   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 %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 %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
 
'gbs_01129
'Date: 03-10-2012
 
Sub CreateListViews
   Local i As Long
   Control Add ListView, hDlg, %IDC_ListViewL, "", 10,40,100,180
   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
   Control Handle hDlg, %IDC_ListViewR To hListviewRight
   ListView Insert Column hDlg, %IDC_ListViewR, 1, "Data", 80, 0
 
   For i = 1 To 100
      ListView Insert Item hDlg, %IDC_ListViewL, 1, 0, Str$(101-i)
      ListView Insert Item hDlg, %IDC_ListViewR, 1, 0, Str$(101-i)
   Next i
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 Long) AS 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 Long) As 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, Msg, wParam, lParam)
End Function

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