lboxex.bas

此源码为vb圣经编码

Attribute VB_Name = "SupportMod"
Option Private Module
Option Explicit

Private Type TwoWords
    LOWORD As Integer
    HIWORD As Integer
End Type
Private Type OneDWord
    DWord As Long
End Type

Public Type OwnedDrawItemStruct
    Owner As ArrayOwner
    pSA() As DRAWITEMSTRUCT
End Type
Public g_DerefDrawItemStruct As OwnedDrawItemStruct

Sub Main()
    InitVBoost
    With g_DerefDrawItemStruct
        InitArrayOwner .Owner, LenB(.pSA(0)), 0
    End With
End Sub

#If SUPPORTOLDSHELL Then
Public Property Get IsNewShell() As Boolean
Static Data As Integer '0=None, 1=NewShell, 2=OldShell
Dim OSVER As OSVERSIONINFO
    If Data = 0 Then
        'Get system information
        With OSVER
            .dwOSVersionInfoSize = Len(OSVER)
            GetVersionEx OSVER
            Data = (Not (.dwMajorVersion <= 3 And .dwMinorVersion < 95)) + 2
        End With
    End If
    IsNewShell = Data - 2
End Property
#End If

Public Function LOWORD(ByVal InVal As Long) As Integer
Dim dw As OneDWord
Dim tw As TwoWords
    dw.DWord = InVal
    LSet tw = dw
    LOWORD = tw.LOWORD
End Function

Public Function HIWORD(ByVal InVal As Long) As Integer
Dim dw As OneDWord
Dim tw As TwoWords
    dw.DWord = InVal
    LSet tw = dw
    HIWORD = tw.HIWORD
End Function

Public Function RedirectLBProc(ByVal This As ListBoxEx, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    RedirectLBProc = This.WindowProc(hWnd, uMsg, wParam, lParam)
End Function

Public Function RedirectLBProcParent(ByVal This As ListBoxEx, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    RedirectLBProcParent = This.WindowProcParent(hWnd, uMsg, wParam, lParam)
End Function