CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 3 of 3

Hybrid View

  1. #1
    Join Date
    Jul 2005
    Location
    Quebec, Canada
    Posts
    75

    Cool Mouse Functions for those who need them

    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.
    Attached Files Attached Files
    Last edited by avidichard; January 19th, 2011 at 02:40 PM.
    David Richard

  2. #2
    Join Date
    Jan 2006
    Location
    Fox Lake, IL
    Posts
    15,007

    Re: Mouse Functions for those who need them

    You could post the code as an attachment...
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

  3. #3
    Join Date
    Jul 2005
    Location
    Quebec, Canada
    Posts
    75

    Resolved Mouse Functions for those who need them + Attachment

    Here is the MOD file (Module file for VB) for those that prefer to download.
    Attached Files Attached Files
    David Richard

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  





Click Here to Expand Forum to Full Width

Featured