I made this module out of several codes I found for many features people may need for there VB applications. You should probably have almost all of what you need for the control of the mouse cursor in this module.
Included in this module:
- X,Y position of the mouse on the screen.
- X,Y (Left, Top) position of the mouse IN A FORM.
- Function that detects if the mouse cursor is outside of a control.
- Function that detects if the cursor is outside a form.
- Functions that return the Left and Top position of a control IN A FORM even if it is in a container.
- Sub that permits to move a frameless form (form with no border).
- Function that detects if a mouse button is pressed anywhere on the screen even if it's not in the form or in a control.
This module helps me a lot and I think it should help many other people.
Code:
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
I Hope this will help many poeple.
Last edited by avidichard; January 19th, 2011 at 02:40 PM.
* The Best Reasons to Target Windows 8
Learn some of the best reasons why you should seriously consider bringing your Android mobile development expertise to bear on the Windows 8 platform.