Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg, hListBox As Dword, OldProc As Long
%IDC_ListBox = 500
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add ListBox, hDlg, %IDC_ListBox, , 10,10,180,200, %WS_VScroll Or %LBS_Notify, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_ListBox To hListBox
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i As Long
Select Case Cb.Msg
Case %WM_InitDialog
OldProc = SetWindowLong(hListBox, %GWL_WndProc, CodePtr(NewProc)) 'subclass
For i = 1 To 100 : ListBox Add hDlg, %IDC_ListBox, Str$(i) : Next
Case %WM_Destroy
SetWindowLong hListBox, %GWL_WNDPROC, OldProc 'un-subclass
End Select
End Function
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Local i As Long, pt As Point, iPos As Integer
Select Case Msg
Case %WM_VScroll
Select Case Lo(Word,wParam)
Case %SB_LineUp
pt.x = 1 : pt.y = 1
iPos = SendMessage(hWnd, %LB_ItemFromPoint, 0, Mak(Word,1,1))
SendMessage hWnd, %LB_SetTopIndex, iPos-5, 0
Function = %True : Exit Function
Case %SB_LineDown
pt.x = 1 : pt.y = 1
iPos = SendMessage(hWnd, %LB_ItemFromPoint, 0, Mak(Word,1,1))
SendMessage hWnd, %LB_SetTopIndex, iPos+5, 0
Function = %True : Exit Function
Case Else
End Select
End Select
Function = CallWindowProc(OldProc, hWnd, Msg, wParam, lParam)
End Function
'gbs_01118
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm