Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type HD_HITTESTINFO
PT As POINTAPI
flags As Long
iItem As Long
End Type
Private Const HHT_ONHEADER As Long = &H2
Private Const HHT_ONDIVIDER As Long = &H4
Private Const HDM_HITTEST As Long = &H1206
Private Const HDN_FIRST As Long = (-300)
Private Const HDN_BEGINTRACKW As Long = (HDN_FIRST - 26)
Private Const HDN_BEGINTRACKA As Long = (HDN_FIRST - 6)
Private Const HDN_DIVIDERDBLCLICKW As Long = (HDN_FIRST - 25)
Private Const HDN_DIVIDERDBLCLICKA As Long = (HDN_FIRST - 5)
' GetWindowsLong Constants
Private Const GWL_WNDPROC = (-4)
' Windows Message Constants
Private Const WM_NOTIFY = &H4E
Private Const WM_DESTROY = &H2
Private Const WM_SETCURSOR = &H20
' Notify Message Header Type
Private Type NMHDR
hWndFrom As Long
idFrom As Long
code As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private mlPrevWndProc As Long
Private Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim HitTestInfo As HD_HITTESTINFO
Dim PT As POINTAPI
Select Case Msg
Case WM_NOTIFY
Dim tNMH As NMHDR
' Copy the Notify Message Header to a Header Structure
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.code
Case HDN_BEGINTRACKW, HDN_BEGINTRACKA, HDN_DIVIDERDBLCLICKW, HDN_DIVIDERDBLCLICKA
Call GetCursorPos(PT)
Call ScreenToClient(tNMH.hWndFrom, PT)
HitTestInfo.flags = HHT_ONHEADER Or HHT_ONDIVIDER
HitTestInfo.PT = PT
Call SendMessage(tNMH.hWndFrom, HDM_HITTEST, 0&, HitTestInfo)
' Lock column 1 (0) and column 2 (1)
If HitTestInfo.iItem = 0 Or HitTestInfo.iItem = 1 Then
Debug.Print "Sorry, I'm locked!"
WindowProc = 1
Exit Function
End If
Debug.Print "OK, you can move me."
End Select
Case WM_DESTROY
' Remove Subclassing when Listview is Destroyed (Form unloaded.)
WindowProc = CallWindowProc(mlPrevWndProc, hwnd, Msg, wParam, lParam)
Call SetWindowLong(hwnd, GWL_WNDPROC, mlPrevWndProc)
Exit Function
End Select
' Call Default Window Handler
WindowProc = CallWindowProc(mlPrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub SubClassHwnd(ByVal hwnd As Long)
mlPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub