Find all our projects in development below.
All source code is GNU General Public License (GPL)
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