'''' ========================================================================
'''' listview defs

#Const WIN32_IE = &H300

'''' user-defined
Public Const LVI_NOITEM = -1

'''' messages
Public Const LVM_FIRST = &H1000
#If (WIN32_IE >= &H300) Then
Public Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
Public Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
#End If

'''' LVM_GETSUBITEMRECT rct.Left
Public Const LVIR_ICON = 1
Public Const LVIR_LABEL = 2

Public Type LVHITTESTINFO   '''' was LV_HITTESTINFO
  pt As POINTAPI
  flags As Long
  iItem As Long
#If (WIN32_IE >= &H300) Then
  iSubItem As Long    '''' this is was NOT in win95.  valid only for LVM_SUBITEMHITTEST
#End If
End Type

'''' LVHITTESTINFO flags
Public Const LVHT_ONITEMLABEL = &H4
''''

#If (WIN32_IE >= &H300) Then

Public Function ListView_GetSubItemRect(hWnd As Long, iItem As Long, iSubItem As Long, _
                                                                    code As Long, prc As RECT) As Boolean
  prc.Top = iSubItem
  prc.Left = code
  ListView_GetSubItemRect = SendMessage(hWnd, LVM_GETSUBITEMRECT, ByVal iItem, prc)
End Function

Public Function ListView_SubItemHitTest(hWnd As Long, plvhti As LVHITTESTINFO) As Long
  ListView_SubItemHitTest = SendMessage(hWnd, LVM_SUBITEMHITTEST, 0, plvhti)
End Function

#End If  '''' '''' WIN32_IE >= &H300

文件三：mSubClass.bas

Option Explicit
''''
'''' Copyright ?1997-1999 Brad Martinez, http://www.mvps.org
''''
Private Const WM_DESTROY = &H2
Private Const WM_KILLFOCUS = &H8

Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = (-4)

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const OLDWNDPROC = "OldWndProc"
''''

Public Function SubClass(hWnd As Long, lpfnNew As Long) As Boolean
  Dim lpfnOld As Long
  Dim fSuccess As Boolean
 
  If (GetProp(hWnd, OLDWNDPROC) = 0) Then
    lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, lpfnNew)
    If lpfnOld Then
      fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
    End If
  End If
 
  If fSuccess Then
    SubClass = True
  Else
    If lpfnOld Then Call UnSubClass(hWnd)
    MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical
  End If
 
End Function

Public Function UnSubClass(hWnd As Long) As Boolean
  Dim lpfnOld As Long
 
  lpfnOld = GetProp(hWnd, OLDWNDPROC)
  If lpfnOld Then
    If RemoveProp(hWnd, OLDWNDPROC) Then
      UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
    End If
  End If

End Function

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Select Case uMsg

    '''' ======================================================
    '''' Hide the TextBox when it loses focus (its LostFocus event it not fired
    '''' when losing focus to a window outside the app).
   
    Case WM_KILLFOCUS
      '''' OLDWNDPROC will be gone after UnSubClass is called, HideTextBox
      '''' calls UnSubClass.
      Call CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
      Call Form1.HideTextBox(True)
      Exit Function
   
    '''' ======================================================
    '''' Unsubclass the window when it''''s destroyed in case someone forgot...
   
    Case WM_DESTROY
      '''' OLDWNDPROC will be gone after UnSubClass is called!
      Call CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
      Call UnSubClass(hWnd)
      Exit Function
     
  End Select
 
  WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
 
End Function

上一页  [1] [2]