- Код: Выделить всё
Option Explicit
'
'
'
'
Implements ISubclass
'
'
'
'
Private Const ID_UDN As Long = &H1000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_COMMAND As Long = &H111
Private Const WM_HSCROLL As Long = &H114
Private Const WM_VSCROLL As Long = &H115
Private Const UDN_FIRST As Long = -721
Private Const UDN_LAST As Long = -740
Private Const UDN_DELTAPOS As Long = (UDN_FIRST - 1)
'
'
'
'
Private Type NMHDR
hwndFrom As Long
idfrom As Long
code As Long
End Type
Private Type NM_UPDOWN
hdr As NMHDR
iPos As Integer
iDelta As Integer
End Type
'
'
'
'
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Private Declare Function CreateUpDownControl Lib "comctl32.dll" ( _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal hParent As Long, _
ByVal nID As Long, _
ByVal hInst As Long, _
ByVal hBuddy As Long, _
ByVal nUpper As Long, _
ByVal nLower As Long, _
ByVal nPos As Long) As Long
Private Declare Function DestroyWindow Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
'
'
'
'
Private m_hWnd As Long
'
'
'
'
Private Sub Form_Load()
m_hWnd = CreateUpDownControl(WS_CHILD Or WS_VISIBLE, _
100, _
100, _
30, _
40, _
hWnd, _
ID_UDN, _
App.hInstance, _
0, _
100, _
0, _
50)
SubClasser.AddSubclassHook hWnd, Me, DoNotTransfer
End Sub
'
'
'
'
Private Sub Form_Unload(Cancel As Integer)
SubClasser.RemoveSubclassHook hWnd
If (m_hWnd) Then DestroyWindow m_hWnd
End Sub
'
'
'
'
Private Function ISubclass_Callback(ByVal hWnd As Long, wMsg As Long, wParam As Long, lParam As Long, ByVal PrevProc As Long) As Long
Dim typHDR As NMHDR
Dim typUPD As NM_UPDOWN
Select Case wMsg
Case WM_NOTIFY
CopyMemory typHDR, ByVal lParam, Len(typHDR)
If (typHDR.code = UDN_DELTAPOS) And (typHDR.idfrom = ID_UDN) Then
CopyMemory typUPD, ByVal lParam, Len(typUPD)
Debug.Print typUPD.iPos
End If
Case Else
ISubclass_Callback = SubClasser.CallWindowProc(PrevProc, hWnd, wMsg, wParam, lParam)
End Select
End Function
После запуска проекта наблюдаю следующий глюк: нажимаю на верхнюю кнопку UpDown, получаю значение 50, затем нажимаю на нижнюю кнопку UpDown и получаю значение 51... а должно быть 49. (и нужно 49)
С чем связан этот глюк? Как его можно избежать?
И еще... iDelta всегда равно нулю... а по здравому смыслу, при уменьшении счетчика, iDelta, наверное, должно быть -1 и при увеличении счетчика +1
Непонятно...
На всякий случай код проекта прилепил.
