Projects

QuickQuery Half-Life Edition

April 11, 2007 by Java

Browsing QuickQuery HL Edition/TabstripSubClassMod.bas (4.86 KB)

Attribute VB_Name = "TabstripSubClassMod"

Private Const GWL_WNDPROC = (-4)
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Const TCM_FIRST = &H1300
Private Const TCM_GETITEMRECT = TCM_FIRST + 10

Private Const SM_SWAPBUTTON = 23

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type SUBCLASSWINDOW
    hWnd As Long
    defProc As Long
    TabstripObj As Object
End Type

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 Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageRECT Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As RECT) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private scWindow() As SUBCLASSWINDOW

Private Function HiWord(wParam As Long) As Long
    HiWord = wParam \ &H10000 And &HFFFF
End Function


Public Function IsMouseSwapped() As Boolean
    IsMouseSwapped = GetSystemMetrics(SM_SWAPBUTTON)
End Function

Private Function LoWord(wParam As Long) As Long
    If wParam And &H8000& Then
        LoWord = &H8000& Or (wParam And &H7FFF&)
    Else
        LoWord = wParam And &HFFFF&
    End If
End Function

Public Sub SubClassTabstripWnd(TabstripObj As Object)
Dim scWnd As SUBCLASSWINDOW
    scWnd.hWnd = TabstripObj.hWnd
    On Error Resume Next
    ReDim Preserve scWindow(UBound(scWindow) + 1)
    If Err Then ReDim scWindow(1)
    scWnd.defProc = SubClass(scWnd.hWnd)
    Set scWnd.TabstripObj = TabstripObj
    scWindow(UBound(scWindow)) = scWnd
End Sub


Private Function SubClass(hWnd As Long) As Long
Dim defWindowProc As Long
On Error Resume Next
    defWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    SubClass = defWindowProc
End Function


Public Sub UnSubClassTabstripWnd(TabstripObj As Object)
On Error Resume Next
Dim i As Integer, scWnd As SUBCLASSWINDOW, found As Integer
    found = -1
    For i = 1 To UBound(scWindow)
    If scWindow(i).hWnd = TabstripObj.hWnd Then
            scWnd = scWindow(i)
            found = i
        End If
    Next
    If found <> -1 Then
        UnSubClass TabstripObj.hWnd, scWnd.defProc
        If found < UBound(scWindow) Then
            For i = found To UBound(scWindow) - 1
                scWindow(i) = scWindow(i + 1)
            Next
        End If
        ReDim Preserve scWindow(UBound(scWindow) - 1)
    End If
End Sub


Public Sub UnSubClassTabstripWndAll()
On Error Resume Next
    If UBound(scWindow) < 1 Then Exit Sub
    If Err <> 0 Then Exit Sub
    Dim i As Integer
    For i = 1 To UBound(scWindow)
        If scWindow(i).hWnd > 0 Then UnSubClass scWindow(i).hWnd, scWindow(i).defProc
    Next i
    ReDim scWindow(0)
End Sub


Private Sub UnSubClass(hWnd As Long, PrevDefProc As Long)
    SetWindowLong hWnd, GWL_WNDPROC, PrevDefProc
End Sub


Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer, bWndFound As Boolean, scWnd As SUBCLASSWINDOW
On Error Resume Next
    For i = 1 To UBound(scWindow)
        If scWindow(i).hWnd = hWnd Then
            bWndFound = True
            scWnd = scWindow(i)
            Exit For
        End If
    Next i
    If bWndFound Then
        If uMsg = WM_LBUTTONDOWN Or (uMsg = WM_RBUTTONDOWN And IsMouseSwapped) Then
            Dim ItemRect As RECT
            Dim CursorPoint As POINTAPI
            CursorPoint.X = LoWord(lParam)
            CursorPoint.Y = HiWord(lParam)
            For i = 1 To scWnd.TabstripObj.Tabs.Count
                SendMessageRECT hWnd, TCM_GETITEMRECT, i - 1, ItemRect
                If PtInRect(ItemRect, CursorPoint.X, CursorPoint.Y) Then
                    If uMsg = WM_LBUTTONDOWN Then
                        PostMessage hWnd, WM_LBUTTONUP, wParam, lParam
                    Else
                        PostMessage hWnd, WM_RBUTTONUP, wParam, lParam
                    End If
                End If
            Next i
            WindowProc = 0
        End If
        WindowProc = CallWindowProc(scWnd.defProc, hWnd, uMsg, wParam, lParam)
    End If
End Function

Download QuickQuery HL Edition/TabstripSubClassMod.bas

Back to file list

---

Back to project page