ComboBox - MouseWheel on Numerical Values

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
%IDC_ComboBox      = 500
 
Global hDlg, hCombo, hComboEdit As Dword, OldEditProc As Long
 
Function PBMain() As Long
   Dim MyArray(4) As String
   Array Assign MyArray() = "10","20","30","40","50"
   Dialog New Pixels, 0, "ComboBox Context Menu",300,300,200,100, %WS_SysMenu, 0 To hDlg
   Control Add ComboBox, hDlg, %IDC_ComboBox, MyArray(), 10,20,150,100
   Control Handle hDlg, %IDC_ComboBox To hCombo
   Control Set Text hDlg, %IDC_ComboBox, "25"
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local ComboInfo As ComboBoxInfo
   Select Case Cb.Msg
      Case %WM_InitDialog
         ComboInfo.cbSize = SizeOf(ComboBoxInfo)
         GetComboBoxInfo(hCombo, ByVal VarPtr(ComboInfo))          'get data about combobox
         hComboEdit = ComboInfo.hwndItem                           'handle to edit control of combobox
         OldEditProc = SetWindowLong(hComboEdit, %GWL_WndProc, CodePtr(NewProc))   'subclass a control
      Case %WM_Destroy
         SetWindowLong hComboEdit, %GWL_WNDPROC, OldEditProc
   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,iValue,iCount As Long, temp$
   Select Case Msg
      Case %WM_KeyDown
         ComboBox Get Select hDlg, %IDC_ComboBox To i
         Select Case wParam
            Case %VK_Up   :  If i = 0 Then GoUpList
            Case %VK_Down :  If i = 0 Then GoDownList
         End Select
      Case %WM_MouseWheel
         ComboBox Get Select hDlg, %IDC_ComboBox To i
         If i = 0 Then
            Select Case Hi(Integer,WParam)    'note the use of Integer
               Case > 0   : GoUpList   'away
               Case < 0   : GoDownList 'to
            End Select
         End If
   End Select
   Function = CallWindowProc(OldEditProc, hWnd, Msg, wParam, lParam)   'send unprocessed messages to the original procedure
End Function
 
Sub GoUpList
   Local temp$, i,iValue,iCount As Long
   Control Get Text hDlg, %IDC_ComboBox To temp$
   iValue = Val(temp$)
   ComboBox Get Count hDlg, %IDC_ComboBox To iCount
   For i = 1 To iCount
      ComboBox Get Text hDlg, %IDC_ComboBox, i To temp$
      If iValue < Val(temp$) Then
         ComboBox Select hDlg, %IDC_ComboBox, i
         Exit For
      End If
   Next i
End Sub
 
Sub GoDownList
   Local temp$, i,iValue,iCount As Long
   Control Get Text hDlg, %IDC_ComboBox To temp$
   iValue = Val(temp$)
   ComboBox Get Count hDlg, %IDC_ComboBox To iCount
   For i = iCount To 1 Step -1
      ComboBox Get Text hDlg, %IDC_ComboBox, i To temp$
      If Val(temp$) < iValue Then
         ComboBox Select hDlg, %IDC_ComboBox, i
         Exit For
      End If
   Next i
End Sub
 
 

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