ListBox - Synchronized Scroll

Category: Controls - .Techniques

Date: 03-28-2012

Return to Index


 
'An online ListBox control tutorial may be found at:
'http://www.garybeene.com/power/pb-tutor-controls.htm
 
'Primary Code:
'Credit: Borje Hagsten
 
'Compilable Example:
'The following compilable code demonstrates a dialog with two
'listbox controls which maintain scroll lock (same position,
'and optionally same selection).
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg As DWord, hList1 as DWord, hList2 as DWord
 
Function PBMain() As Long
   Local i as long
   Dim MyArray(20) As String
   For i = 0 to 20 : MyArray(i) = "Line" + Format$(i, "00") : Next i
   Dialog New Pixels, 0, "ListBox Test",300,300,190,150, %WS_SysMenu, 0 To hDlg
   Control Add Checkbox, hDlg, 125, "Sync Selection", 10,10,75,20
   Control Add ListBox, hDlg, 100, MyArray(), 10,40,75,100
   Control Handle hDlg, 100 to hList1
   Control Add ListBox, hDlg, 200, MyArray(), 100,40,75,100
   Control Handle hDlg, 200 to hList2
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Static NoUpdate As Long 'to avoid un-neccessay updating
   Select Case CB.Msg
      Case %WM_CTLCOLORLISTBOX    'wParam: hDC    lParam: hList
         If NoUpdate Then Exit Function
         NoUpdate = %True
         Local ln1 as Long, ln2 as Long, iState as Long
         Control Get Check hDlg, 125 To iState
         If iState Then
            'optionally sync on selection
            ln1 = SendMessage(hList1, %LB_GETCURSEL, 0, 0)
            ln2 = SendMessage(hList2, %LB_GETCURSEL, 0, 0)
            If CB.lParam = hList1 AND ln1 <> ln2 Then
               SendMessage(hList2, %LB_SETCURSEL, ln1, 0)
            Else
               SendMessage(hList1, %LB_SETCURSEL, ln2, 0)
            End If
         End If
         'sync on top line
         ln1 = SendMessage(hList1, %LB_GETTOPINDEX, 0, 0)   '1st visible line
         ln2 = SendMessage(hList2, %LB_GETTOPINDEX, 0, 0)
         If CB.lParam = hList1 AND ln1 <> ln2 Then
            SendMessage hList2, %LB_SETTOPINDEX, ln1, 0
         Else
            SendMessage hList1, %LB_SETTOPINDEX, ln2, 0
         End If
         NoUpdate = %False
   End Select
End Function
 
'gbs_00287
'Date: 03-10-2012


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