Option Explicit
 
'*************************************************************************
' Modul:        modListener.bas (SubClassing)
' Beschreibung: Windows Messages an Forms abfangen und auf die
'               Funktion WindowProc des entsprechenden Forms umleiten.
' Datum:        14.03.2001 Th. Bannert
'*************************************************************************
 
' API Deklarationen
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, _
     ByVal Length As Long)
 
Public Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long
Public Declare Function ScreenToClient Lib "user32" _
    (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
 
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Any, _
     lParam As Any) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" _
    (ByVal hWnd As Long, ByVal lpString As String) As Long
 
Public 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 SetProp Lib "user32" Alias "SetPropA" _
    (ByVal hWnd As Long, ByVal lpString As String, _
     ByVal hData As Long) As Long
 
Public Const GWL_STYLE          As Long = (-16)
 
Public Const WM_USER            As Long = &H400
Public Const WM_SIZE            As Long = &H5
Public Const WM_NOTIFY          As Long = &H4E&
 
Public Const LVM_FIRST = &H1000
Public Const LVM_GETHEADER = (LVM_FIRST + 31)
 
Public Const HDM_FIRST           As Long = &H1200
Public Const HDM_HITTEST         As Long = (HDM_FIRST + 6)
 
Public Const HDN_FIRST As Long = -300&
Public Const HDN_DIVIDERDBLCLICK = (HDN_FIRST - 5)
Public Const HDN_BEGINTRACK = (HDN_FIRST - 6)
Public Const HDN_ITEMCLICK = (HDN_FIRST - 2)
 
Public Const HHT_ONHEADER = &H2
Public Const HHT_ONDIVIDER = &H4
 
 
Public Type NMHDR
   hWndFrom As Long
   idfrom   As Long
   code     As Long
End Type
 
Public Type POINTAPI
   X As Long
   Y As Long
End Type
 
Public Type HD_HITTESTINFO
   pt  As POINTAPI
   flags  As Long
   iItem As Long
End Type
 
Private Const GWL_WNDPROC  As Long = (-4)
 
Public Function Listener(ByVal hWnd As Long, _
                         ByVal Msg As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As Long) As Long
 
   Dim lPointer     As Long
   ' !!WICHTIG!! das folgende objekt oForm MUSS
   ' als das Form deklariert werden, in dem sich das ListView
   ' und die Funktion WindowProc befinden.
   ' In diesem Beispiel also Form1 UNBEDINGT anpassen!!!
   Dim oForm        As Form1
 
   lPointer = GetProp(hWnd, "FormPointer")
 
   If (lPointer <> 0) Then
      CopyMemory oForm, lPointer, 4
      On Error Resume Next
      Listener = oForm.WindowProc(hWnd, Msg, wParam, lParam)
      If (Err) Then
         RemListener hWnd
         Debug.Print "Listener Error, #"; CStr(Err.Number)
         Debug.Print "  Message, hWnd: &h"; Hex(hWnd), "Msg: &h"; Hex(Msg), _
           "Params:"; wParam; lParam
      End If
      lPointer = 0
      CopyMemory oForm, lPointer, 4
   End If
End Function
 
Public Sub SetListener(hWnd As Long, oForm As Form)
  Dim lPointer     As Long
  ' Pointer zum übergebenen Form welches die neue "WindowProc"
  ' enthällt
  CopyMemory lPointer, oForm, 4 ' Pointer
  ' Pointer zum Form sichern
  Call SetProp(hWnd, "FormPointer", lPointer)
  ' ursprüngliche Prozeduradresse sichern
  Call SetProp(hWnd, "OldWindowProc", GetWindowLong(hWnd, GWL_WNDPROC))
  ' ursprüngliche Prozeduradresse zuseisen
  Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Listener)
End Sub
 
Public Sub RemListener(hWnd As Long)
  ' Entfernen des Listeners !!!WICHTIG!!!
  Dim lPointer As Long
  lPointer = GetProp(hWnd, "OldWindowProc")
  If (lPointer <> 0) Then
    Call SetWindowLong(hWnd, GWL_WNDPROC, lPointer)
  End If
End Sub

Option Explicit
 
Private bAllowColResize As Boolean
 
Private Sub cmdResize_Click()
  bAllowColResize = Not bAllowColResize
End Sub
Private Sub Form_Load()
  Dim i, ii         As Long
  Dim oItem         As ListItem
  For i = 1 To 5
    ListView1.ColumnHeaders.Add , , "Colum_" & i
  Next i
  For i = 1 To 50
    Set oItem = ListView1.ListItems.Add(, , "Item_" & i)
    For ii = 1 To 4
      oItem.SubItems(ii) = "SubItem_" & i & "_" & ii
    Next ii
  Next i
  ListView1.View = lvwReport 
  Call SetListener(ListView1.hWnd, Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
  ' WICHTIG!!!!
  Call RemListener(ListView1.hWnd)
End Sub
Friend Function WindowProc(hWnd As Long, _
                           Msg As Long, _
                           wParam As Long, _
                           lParam As Long) As Long
  '--------------------------------------------------
  Dim NotiyMsg      As NMHDR
  Dim oPT           As POINTAPI
  Dim oHTI          As HD_HITTESTINFO
  Dim lHeader       As Long
  '--------------------------------------------------
  Select Case Msg
    Case WM_NOTIFY
      ' Die Message auswerten
      Call CopyMemory(NotiyMsg, ByVal lParam, Len(NotiyMsg))
      'Debug.Print NotiyMsg.code
      Select Case NotiyMsg.code
        Case HDN_BEGINTRACK         ' Größenänderung unterdrücken
          If Not bAllowColResize Then WindowProc = 1: Exit Function
        Case HDN_DIVIDERDBLCLICK    ' Größenänderung per Doppelklick 
        ' unterdrücken
          If Not bAllowColResize Then WindowProc = 1: Exit Function
        Case HDN_ITEMCLICK       ' ItemClick
          ' ItemClick bei ColHeader unterdrücken
          Debug.Print "HDN_ITEMCLICK"
          WindowProc = 1
          Exit Function
        Case -16        ' ColumnClick im Flat Style
          ' Handle des CoulumnHeaders
          lHeader = SendMessage(ListView1.hWnd, LVM_GETHEADER, 0&, ByVal 0&)
          If lHeader Then
            ' Welcher ColumnHeader wurde angeklickt
            Call GetCursorPos(oPT)
            Call ScreenToClient(lHeader, oPT)
            With oHTI
              .flags = HHT_ONHEADER Or HHT_ONDIVIDER
              .pt = oPT
            End With
            Call SendMessage(lHeader, HDM_HITTEST, 0&, oHTI)
            If oHTI.flags = HHT_ONHEADER Then
              ' Nun das Click Ereignis auslösen
              Call ListView1_ColumnClick(ListView1.ColumnHeaders(oHTI.iItem + _
                1))
              ' keine weitere Benachrichtigung an das Form
              Exit Function
            End If
          End If
      Case Else
      End Select
    Case Else
  End Select
  ' Event an das Form weitergeben
  WindowProc = CallWindowProc(GetProp(hWnd, _
                              "OldWindowProc"), _
                              hWnd, Msg, wParam, lParam)
  '--------------------------------------------------
End Function
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As _
  MSComctlLib.ColumnHeader)
  Debug.Print "ListView1_ColumnClick " & ColumnHeader.Text
End Sub