wParam As Long, _ lParam As Any) As Long '''' <---
'''' ======================================================================== '''' 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] [VB.NET程序]VB编辑ListView的SubItem
|