Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

QuickQuery Half-Life Edition

Browsing QuickQuery HL Edition/SubClassCBMod.bas (2.59 KB)

Attribute VB_Name = "SubClassCBMod"
Option Explicit

Private Const GWL_WNDPROC = (-4)
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONUP = &H205

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) 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 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 SubClassObject As Long
Private OldWindowProc As Long



Public Sub EndCBSubClass()
    UnSubClass SubClassObject, OldWindowProc
End Sub

Public Sub StartCBSubClass(ByVal hWnd As Long)
    SubClassObject = hWnd
    SubClass SubClassObject
End Sub


Private Sub SubClass(hWnd As Long)
    OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
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
On Error Resume Next
Dim CursorPos As POINTAPI
Dim i As Integer
    If SubClassObject = hWnd Then
        If uMsg = WM_RBUTTONUP Or (uMsg = WM_LBUTTONUP And IsMouseSwapped() = True) Then
            GetCursorPos CursorPos
            ScreenToClient hWnd, CursorPos
            If CursorPos.X > ((ServerQueryForm.cboAddress.Width / Screen.TwipsPerPixelX) - 20) Then
                ServerQueryForm.RemoveMenu.Enabled = False
                If ServerQueryForm.cboAddress.Text <> "" Then
                    For i = 0 To ServerQueryForm.cboAddress.ListCount - 1
                        If LCase(ServerQueryForm.cboAddress.Text) = LCase(ServerQueryForm.cboAddress.List(i)) Then
                            ServerQueryForm.RemoveMenu.Enabled = True
                            Exit For
                        End If
                    Next i
                End If
                ServerQueryForm.PopupMenu ServerQueryForm.CBPopupMenu, , ServerQueryForm.cboAddress.Left + (CursorPos.X * Screen.TwipsPerPixelX), ServerQueryForm.cboAddress.Top + (CursorPos.Y * Screen.TwipsPerPixelY)
            End If
        End If
        WindowProc = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
    End If
End Function


Download QuickQuery HL Edition/SubClassCBMod.bas

Back to file list


Back to project page