Attribute VB_Name = "ModMouse" Option Explicit Private Const HTCAPTION As Long = 2 Private Const WM_NCLBUTTONDOWN = &HA1 Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, Lparam As Any) As Long Public Const MOUSE_BUTTON_LEFT As Long = 1 Public Const MOUSE_BUTTON_RIGHT As Long = 2 Public Const MOUSE_BUTTON_MIDDLE As Long = 4 Type POINT_TYPE x As Long y As Long End Type Public Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Public Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long Public Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINT_TYPE) As Long Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Const lTwipsPerPixel As Long = 15 ' Number of twips in 1 pixel Private WinBorderWidth As Long ' Windows border width in pixels Private WinTitleHeight As Long ' Windows title height in pixels Private FormRef As Form ' Form referenced in SetWinBorderSize ' This sub must be called before working with the Mouse positions here. ' When you call for the first time, bFirstTime must be set to true. ' oForm is a window that has the same properties as the windows you want to work with. ' If a window is sizable, then you must use a sizable form as a reference ' MDIForms are considered sizable windows. ' This function must always be called before using the border sizes ' ====================================================================================== ' WARNING: oForm WILL be loaded. Make sure no code is ran in the Form_Load of the form. ' ====================================================================================== ' sFormNameIn is the name of the form in which you are working, this will set ' FormRef's window properties the same as the form in which you are in. ' The best example is when you set the windows to maximized or normal, in that case ' borders change sizes. Public Sub SetWinBorderSize(ByVal oForm As Form, Optional ByVal sFormNameIn As String, Optional ByVal bFirstTime As Boolean = False) Dim bFormFound As Boolean Dim bChangeSizes As Boolean Dim oFrm As Form bFormFound = False bChangeSizes = False ' Check if oForm is loaded For Each oFrm In Forms ' Check if window states have changed in the form we are in If (LCase(oFrm.Name) = LCase(sFormNameIn) And sFormNameIn <> "") Then If oForm.WindowState <> oFrm.WindowState Then If Not (oFrm Is oForm) Then oForm.WindowState = oFrm.WindowState bChangeSizes = True End If End If ' Check to see if form oForm is the current form If oFrm.Name = oForm.Name Then bFormFound = True Next oFrm ' Load oForm if not loaded already If bFormFound = False Then Load oForm ' Attribute's the FormRef to oForm if not done yet If FormRef Is Nothing Then Set FormRef = oForm ' If the form did not change size or state, exit If bChangeSizes = False And bFirstTime = False Then Exit Sub ' Get the border width WinBorderWidth = (oForm.Width - oForm.ScaleWidth) / lTwipsPerPixel WinBorderWidth = WinBorderWidth / 2 ' Get the title height WinTitleHeight = (oForm.Height - oForm.ScaleHeight) / lTwipsPerPixel WinTitleHeight = WinTitleHeight - WinBorderWidth End Sub ' Real X position of the form on the screen. Doesn't count the borders as it normally does. Public Function FormRealPosX(ByVal oFrm As Form) As Long SetWinBorderSize FormRef, oFrm.Name FormRealPosX = (oFrm.Left / lTwipsPerPixel) + WinBorderWidth End Function ' Real Y position of the form on the screen. Doesn't count the borders as it normally does. Public Function FormRealPosY(ByVal oFrm As Form) As Long SetWinBorderSize FormRef, oFrm.Name FormRealPosY = (oFrm.Top / lTwipsPerPixel) + WinTitleHeight End Function ' Move a frameless form Public Sub MoveForm(ByVal oForm As Form) ReleaseCapture SendMessage oForm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0 End Sub ' Get left mouse position on the screen Public Function vbMouseLeft() As Long Dim Cursor As POINT_TYPE GetCursorPos Cursor vbMouseLeft = Cursor.x * lTwipsPerPixel End Function ' Get left mouse position on the screen Public Function vbMouseTop() As Long Dim Cursor As POINT_TYPE GetCursorPos Cursor vbMouseTop = Cursor.y * lTwipsPerPixel End Function ' X position of the cursor in the form oFrm Public Function vbCursorX(ByVal oFrm As Form) As Long Dim Cursor As POINT_TYPE GetCursorPos Cursor vbCursorX = Cursor.x - FormRealPosX(oFrm) End Function ' Y position of the cursor in the form oFrm Public Function vbCursorY(ByVal oFrm As Form) As Long Dim Cursor As POINT_TYPE GetCursorPos Cursor vbCursorY = Cursor.y - FormRealPosY(oFrm) End Function ' Detects if the mouse is outside a form Public Function MouseOutForm(ByVal oFrm As Form) As Boolean Dim XL As Single Dim XR As Single Dim YT As Single Dim YD As Single Dim RX As Single Dim RY As Single Dim bMouseOut As Boolean bMouseOut = False ' Get cursor X, Y positions RX = vbCursorX(oFrm) RY = vbCursorY(oFrm) ' Get left and right X positions of the control IN THE FORM oFrm XL = 0 XR = oFrm.Width / lTwipsPerPixel ' Get top and bottom Y positions of the control IN THE FORM oFrm YT = 0 YD = oFrm.Height / lTwipsPerPixel ' Checks if cursor is outside of the control If RX < XL Or RX > XR Or RY < YT Or RY > YD Then bMouseOut = True MouseOutForm = bMouseOut End Function ' Detects if the cursor is outside of a control (oCtl) Public Function MouseOut(ByVal oFrm As Form, ByVal oCtl As Control) As Boolean Dim XL As Single Dim XR As Single Dim YT As Single Dim YD As Single Dim RX As Single Dim RY As Single Dim bMouseOut As Boolean bMouseOut = False ' Get cursor X, Y positions RX = vbCursorX(oFrm) RY = vbCursorY(oFrm) ' Get left and right X positions of the control IN THE FORM oFrm XL = fLeft(oFrm, oCtl) / lTwipsPerPixel XR = XL + (oCtl.Width / lTwipsPerPixel) ' Get top and bottom Y positions of the control IN THE FORM oFrm YT = fTop(oFrm, oCtl) / lTwipsPerPixel YD = YT + (oCtl.Height / lTwipsPerPixel) ' Checks if cursor is outside of the control If RX < XL Or RX > XR Or RY < YT Or RY > YD Then bMouseOut = True MouseOut = bMouseOut End Function ' Detects if a mouse button is pressed anywhere on the screen Public Function MouseButtonDown(ByVal lMouseButton As Long) As Boolean Dim iKeyPressed As Long Dim bPressed As Boolean bPressed = False iKeyPressed = GetAsyncKeyState(lMouseButton) If iKeyPressed <> 0 Then bPressed = True MouseButtonDown = bPressed End Function ' Returns the top position of a control in a form Public Function fTop(ByVal frm As Form, ByVal Ctl As Control) As Single If Ctl.Container Is frm Then fTop = Ctl.Top Else fTop = Ctl.Top + fTop(frm, Ctl.Container) End If End Function ' Returns the left position of a control in a form Public Function fLeft(ByVal frm As Form, ByVal Ctl As Control) As Single If Ctl.Container Is frm Then fLeft = Ctl.Left Else fLeft = Ctl.Left + fLeft(frm, Ctl.Container) End If End Function