uclistview.ctl

需要控件：Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long



'========================================================================================
' Subclass handler - MUST be the first Public routine in this file. That includes public properties also
'========================================================================================

Public Sub zSubclass_Proc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByRef lng_hWnd As Long, ByRef uMsg As Long, ByRef wParam As Long, ByRef lparam As Long)
Attribute zSubclass_Proc.VB_MemberFlags = "40"

'Parameters:
'   bBefore  - Indicates whether the the message is being processed before or after the default handler - only really needed if a message is set to callback both before & after.
'   bHandled - Set this variable to True in a 'before' callback to prevent the message being subsequently processed by the default handler... and if set, an 'after' callback
'   lReturn  - Set this variable as per your intentions and requirements, see the MSDN documentation for each individual message value.
'   lng_hWnd - The window handle
'   uMsg     - The message number
'   wParam   - Message related data
'   lParam   - Message related data
'
'Notes:
'   If you really know what you're doing, it's possible to change the values of the
'   hWnd, uMsg, wParam and lParam parameters in a 'before' callback so that different
'   values get passed to the default handler.. and optionaly, the 'after' callback

  Dim uNMH     As NMHDR
  Dim uNMLV    As NMLISTVIEW
  Dim uNMLVDI  As NMLVDISPINFO
  Dim uNMLVKD  As NMLVKEYDOWN
  Dim uLVHTI   As LVHITTESTINFO
  Dim uHDHTI   As HDHITTESTINFO
  Dim nCancel  As Integer
  Dim bMouseUp As Boolean
  Dim snx      As Single
  Dim sny      As Single
  Dim a()      As Byte
  Dim lPos     As Long
  Dim sText    As String
  Dim lIdx     As Long
  
    Select Case lng_hWnd
    
        Case UserControl.hWnd
        
            Select Case uMsg
                
                Case WM_MOUSEACTIVATE
                    
                    Call pvSetIPAO
                                    
                Case WM_NOTIFY
                    
                    Call CopyMemory(uNMH, ByVal lparam, Len(uNMH))
                
                    If (uNMH.hwndFrom = m_hHeader) Then
                        
                        If (m_hHeader) Then
                        
                            With uHDHTI
                                
                                Call GetCursorPos(.pt)
                                Call ScreenToClient(m_hHeader, .pt)
                                Call SendMessage(m_hHeader, HDM_HITTEST, 0, uHDHTI)
    
                                Select Case uNMH.code
                                        
                                    Case HDN_ITEMCHANGING 'HDN_BEGINTRACK not intercepted ?
                                    
                                        If (m_HeaderFixedWidth) Then
                                            lReturn = 1
                                            bHandled = True
                                        End If
                                      
                                    Case HDN_ITEMCLICK
                                    
                                        RaiseEvent ColumnClick(CInt(.iItem))
                                    
                                    Case NM_RCLICK
                                          
                                        If (uNMH.hwndFrom = m_hHeader) Then
                                            RaiseEvent ColumnRightClick(CInt(.iItem))
                                            Exit Sub
                                        End If
                                End Select
                            End With
                        End If
                        
                    ElseIf (uNMH.hwndFrom = m_hListView) Then
                     
                        Select Case uNMH.code
                           
                            Case NM_CUSTOMDRAW
                                
                                If (m_RaiseSubItemPrePaint) Then
                                    lReturn = pvCustomDraw(lparam)
                                    bHandled = True
                                End If
                                
                            Case NM_CLICK, NM_RCLICK
                                
                                Call CopyMemory(uNMLV, ByVal lparam, Len(uNMLV))
                                With uLVHTI
                                    Call pvUCCoordPixel(.pt.x, .pt.y)
                                    Call SendMessage(m_hListView, LVM_HITTEST, 0, uLVHTI)
                                    If (Not m_MultiSelect) Then
                                        If (.flags <> LVHT_NOWHERE) Then
                                            If ((.flags = LVHT_ONITEMICON) Or _
                                                (.flags = LVHT_ONITEMLABEL) Or _
                                                (.flags = LVHT_ONITEM)) Then
                                                bMouseUp = True
                                            End If
                                        End If
                                      Else
                                        If (.flags <> LVHT_ONITEMSTATEICON) Then
                                            bMouseUp = True
                                        End If
                                    End If
                                End With
                                If (bMouseUp) Then
                                    Call pvUCCoordScale(snx, sny)
                                    RaiseEvent MouseUp((uNMH.code = NM_CLICK) + 2, pvShiftState(), snx, sny)
                                    RaiseEvent Click
                                End If
                                
                            Case NM_DBLCLK, NM_RDBLCLK
                            
                                RaiseEvent DblClick
                    
                            Case LVN_ITEMCHANGED
                            
                                Call CopyMemory(uNMLV, ByVal lparam, Len(uNMLV))
                                With uNMLV
                                    If (.uOldState) Then
                                        If ((.uNewState And LVIS_STATEIMAGEMASK) <> (.uOldState And LVIS_STATEIMAGEMASK)) Then
                                            RaiseEvent ItemCheck(CInt(.iItem))
                                        End If
                                      Else
                                        If (Not m_bFirstItem) Then
                                            If ((.uNewState And LVIS_SELECTED)) Then
                                                RaiseEvent ItemClick(CInt(.iItem))
                                            End If
                                        End If
                                    End If
                                End With
                                
                            Case LVN_BEGINLABELEDIT
                                
                                RaiseEvent BeforeLabelEdit(nCancel)
                                If (nCancel) Then
                                    Call SendMessageLong(pvEdithWnd(), WM_KILLFOCUS, 0, 0)
                                End If
                                
                            Case LVN_ENDLABELEDIT
                                
                                Call CopyMemory(uNMLVDI, ByVal lparam, Len(uNMLVDI))
                                With uNMLVDI.Item
                                    If (lstrlen(.pszText) > 1) Then
                                        ReDim a(0 To .cchTextMax - 1) As Byte
                                        Call CopyMemory(a(0), ByVal .pszText, .cchTextMax - 1)
                                        sText = StrConv(a(), vbUnicode)
                                        lPos = InStr(sText, vbNullChar)
                                        sText = IIf(lPos > 1, Left$(sText, lPos - 1), vbNullString)
                                    End If
                                    RaiseEvent AfterLabelEdit(nCancel, sText)
                                    If (nCancel = 0 Xor GetAsyncKeyState(vbKeyEscape)) Then
                                        lReturn = 1
                                        bHandled = True
                                    End If
                                End With
                        End Select
                    End If
            End Select
            
        Case m_hListView
            
            Select Case uMsg
                
                Case WM_SETFOCUS
                    
                    Call pvSetIPAO
                    
                Case WM_KEYDOWN
                    
                    RaiseEvent KeyDown(wParam And &H7FFF&, pvShiftState())
                    
                Case WM_CHAR
                    
                    RaiseEvent KeyPress(wParam And &H7FFF&)
                    If ((wParam And &H7FFF&) = vbKeySpace) Then
                        lIdx = SendMessageLong(m_hListView, LVM_GETNEXTITEM, -1, LVNI_SELECTED Or LVNI_FOCUSED)
                        If (lIdx <> -1) Then
                            RaiseEvent ItemClick(CInt(lIdx))
                        End If
                    End If
                    
                Case WM_KEYUP
                    
                    RaiseEvent KeyUp(wParam And &H7FFF&, pvShiftState())
                    
                Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
                    
                    Call pvUCCoordScale(snx, sny)
                    RaiseEvent MouseDown(pvButton(uMsg), pvShiftState(), snx, sny)
                    lIdx = pvItemHitTest()
                    If (lIdx <> -1) Then
                        With uLVHTI
                            Call pvUCCoordPixel(.pt.x, .pt.y)
                            Call SendMessage(m_hListView, LVM_HITTEST, 0, uLVHTI)
                            If ((.flags = LVHT_ONITEMICON) Or _
                                (.flags = LVHT_ONITEMLABEL) Or _
                                (.flags = LVHT_ONITEM)) Then
                                If (SendMessageLong(m_hListView, LVM_GETITEMSTATE, lIdx, LVIS_SELECTED Or LVIS_FOCUSED)) Then
                                    RaiseEvent ItemClick(CInt(lIdx))
                                End If
                            End If
                        End With
                    End If
               
                Case WM_MOUSEMOVE
                    
                    If (Not m_bInCtrl) Then
                        m_bInCtrl = True
                        Call pvTrackMouseLeave(lng_hWnd)
                        RaiseEvent MouseEnter
                    End If
                    Call pvUCCoordScale(snx, sny)
                    If (snx <> m_snxL Or sny <> m_snyL) Then
                        m_snxL = snx
                        m_snyL = sny
                        RaiseEvent MouseMove(pvButton(uMsg), pvShiftState(), snx, sny)
                    End If
                    
                Case WM_MOUSELEAVE
                
                    m_bInCtrl = False
                    RaiseEvent MouseLeave
                    m_snxL = -1
                    m_snyL = -1
                    
                Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
                    
                    Call pvUCCoordScale(snx, sny)
                    RaiseEvent MouseUp(pvButton(uMsg), pvShiftState(), snx, sny)
                    RaiseEvent Click
            End Select
    End Select
End Sub

'========================================================================================
' Usercontrol
'========================================================================================

Private Sub UserControl_Initialize()

    m_hModShell32 = LoadLibraryA("shell32.dll") '(*)
    Call InitCommonControls
    Set m_oFont = New StdFont
    
'(*) KBID 309366 (http://support.microsoft.com/default.aspx?scid=kb;en-us;309366)
'    From vbAccelerator
'    http://www.vbaccelerator.com/home/VB/Code/Libraries/XP_Visual_Styles/Preventing_Crashes_at_Shutdown/article.asp
End Sub

Private Sub UserControl_Terminate()
  
  On Error GoTo errH
  
    If (m_bInitialized) Then
    
        Call mIOleInPlaceActivate.TerminateIPAO(m_uIPAO)
        Call Subclass_StopAll
        Call pvDestroyImageListSmall
        Call pvDestroyImageListLarge
        Call pvDestroyImageListHeader
        Call pvDestroyFont
        Call pvDestroyListView
        Call FreeLibrary(m_hModShell32)
    End If
errH:
End Sub

'//

Private Sub UserControl_GotFocus()

    If (m_hListView) Then
    
        Call SetFocus(m_hListView)
    End If
End Sub

Private Sub UserControl_Resize()

  Dim rctClient As RECT2
  
    If (m_hListView) Then
    
        Call GetClientRect(UserControl.hWnd, rctClient)
        With rctClient
            Call SetWindowPos(m_hListView, 0, .X1, .Y1, .X2 - .X1, .Y2 - .Y1, SWP_NOZORDER Or SWP_NOOWNERZORDER)
        End With
        RaiseEvent Resize
    End If
End Sub

'========================================================================================
' Methods
'========================================================================================

Public Function Initialize() As Boolean
    
    If (m_bInitialized = False) Then
    
        Initialize = pvCreate()
        
        If (m_hListView) Then
        
            m_bInitialized = True
            
            '-- Subclass UserControl (parent) and ListView (child)
            Call Subclass_Start(UserControl.hWnd)
            Call Subclass_Start(m_hListView)