Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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 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
'gbs_01130
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm