Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
'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
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm