Make record current on MouseMove in continuous subform

Try this

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0, 0
End Sub

gaw

Does what it says on the tin, but presents a slight problem... to avoid constantly repeating the mouse_event call, you have to insert some sort of flag to tell the code that the button has already been clicked.  Constantly repeating the call means that the ControlTipText does not have time to appear, so that doesn't work, and if you insert a flag, there seems to be no way of resetting that flag when you move off that button, or having the flag only applicable to that instance of the button.  So, if I set the flag, the ControlTipText is indeed set and then appears, but then moving on to the next instance of the button just makes the same text appear.

Does that make sense?

Add a public variable ctlTextBox to the code module. Then change the MouseMove event.

Private ctlTextBox As Control

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If ctlTextBox.Name <> "Text1" Then
        mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0, 0
    End If
End Sub

Thanks!

Joe

That definitely doesn't make sense... what do I set ctlTextBox to?  Plus, all the controls are called "Text1", which is part of the problem, because although they contain different data, they do not have different names (or any sort of index I can find).

I'm sure I'm misunderstanding the point though, so can you clarify?

Then, try the code gwgaw supplied but make a couple of changes.

In the general declarations section, declare a variable of the type that the Text1 textboxes are. Then, you can use that variable to decide which item you are over.

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If sItem <> Text1 Then
       mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0, 0
       sItem = Text1
   End If
End Sub

What happens is that when you move over a textbox, it will set the String sItem to the contents of the textbox. Then, when you move over the next textbox, its contents will be different so it will show the ToolTip.

Thanks!

Joe

Think we're missing the point here. I don't believe that the original problem is displaying different info as you move ACROSS fields on a given row (i.e. Text1, then Text2, then Text 3 etc), but when you move DOWN through the (displayed) rows on the continuous form.
I think the question is "how to display the Control Tip + contents of Text1 (from Row1) and then the Control Tip + contents of Text1 (from Row2) .... etc etc.

As a continuous form is really ONLY a single (defined) row of fields "repeated" for however many times is necessary, the ONLY "Text1 field" available at the time a mouse moves over it is from ROW1, and it will only ever be (and will only show) details from Text1 of ROW1 (or at least the row that is CURRENT, but that requires "clicking" onto such row first, whic is NOT what the questioner was asking to happen).

The simple answer is .... you can't do it, as the ONLY details that are available for ANY field are only those from the CURRENT row.

Correct archery, I can display text from a text box in the controltip, that is not difficult.  What is difficult is making the record I am on the current record so that when I ask for the text value of the text box it gives me the one I am after, which I can only seem to do by clicking somewhere on that record.  The code gwgaw gave me works to click the button I am on, but the problem then lies in only letting it click once on the text box.  If I can find a way of only letting it click once then my problem is solved, as the act of clicking makes that record become current.

So I guess what I'm asking is "how do you stop gwgaw's code running more than once for each instance of the control?"

I'm upping the points on this because I really need an answer...

This will work only if the form is a subform.

Add the following line to the form's declarations section.

Private oldRC As RECT 'Stores the current row's textbox position and size

Change the mousemove event to...

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pt As POINTAPI  'Cursor position
Dim rc As RECT      'Position and size of the current row's textbox under the cursor
WhichTextBox Me, Text1, Y, pt, rc
If PtInRect(oldRC, pt.X, pt.Y) = 0 Then
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    oldRC = rc
End If
Text1.ControlTipText = "Whatever you want"
end sub

Add a bas module and add the following code.

Private Declare Function GetClassNameApi Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

'GetDeviceCaps constants
Private Const LOGPIXELSX = 88   'Pixels per logical inch in X
Private Const LOGPIXELSY = 90   'Pixels per logical inch in Y

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

Public TwipsPerPixelX As Long   'Twips per pixel for screen in X
Public TwipsPerPixelY As Long   'Twips per pixel for screen in Y

Public Function WhichTextBox(sfForm As Form, txtBox As TextBox, sY As Single, ptXY As POINTAPI, rcTB As RECT)
Dim dl As Long, lgHwnd As Long
Dim lgYOffset As Long   'Offset for the current row
Dim rcF As RECT         'Form's size and position
Dim ptF As POINTAPI     'Form's top, left
If TwipsPerPixelX = 0 Then GetPixelsXY
'Get the handle of Access's MDIClient
lgHwnd = GetMDIClientHwnd()
'Get the form's top position and convert to MDIClient coordinates
dl = GetWindowRect(sfForm.hwnd, rcF)
ptF.Y = rcF.Top
ScreenToClient lgHwnd, ptF
'Get the cursor position
GetCursorPosition ptXY, lgHwnd
'Calculate the Y offset for the current row's position
lgYOffset = ptXY.Y - ptF.Y * TwipsPerPixelY - sY
GetTextBoxPosition rcTB, lgHwnd, sfForm, txtBox.Name
'Add in the row offset
rcTB.Top = rcTB.Top + lgYOffset
rcTB.Bottom = rcTB.Bottom + lgYOffset
End Function

Private Sub GetTextBoxPosition(rcBtn As RECT, ByVal MDIHwnd As Long, frm As Form, stCtl As String)
Dim lgBorderWidth As Long, lgCaptionHeight As Long
Dim lgSelectorWidth As Long, lgSectionHieghts As Long
Dim ptF As POINTAPI, rc1 As RECT
Dim dl As Long
With frm
    'Get form's border width and caption height
    lgBorderWidth = (.WindowWidth - .InsideWidth) / 2
    lgCaptionHeight = (.WindowHeight - .InsideHeight - lgBorderWidth)
    'If the form's NavigationButtons property is true we need to subtract
    'the height of the navigation buttons from the caption height
    'by subtracting the form's InsideHeight from it's client height
    If .NavigationButtons Then
        dl = GetClientRect(.hwnd, rc1)   'rc1.Bottom is the form's client height in pixels
        lgCaptionHeight = lgCaptionHeight - (rc1.Bottom * TwipsPerPixelY - .InsideHeight)
    End If
    'If the form's RecordSelectors property is true we need to
    'add the width of the record selector to the button's Left property
    'by subtracting the form's Width from its InsideWidth
    lgSelectorWidth = .InsideWidth - .Width
    'Get form's position in screen coordinates
    dl = GetWindowRect(.hwnd, rc1)
End With
'Convert form's left, top position to MDIClient coordinates
ptF.X = rc1.Left: ptF.Y = rc1.Top
ScreenToClient MDIHwnd, ptF
With frm(stCtl)
    'Get the form's section hieghts
    lgSectionHieghts = SectionHieghts(frm, .Section)
    'Get the control's position in relation to the MDIClient's left and top
    ptF.X = ptF.X * TwipsPerPixelX + .Left + lgBorderWidth + lgSelectorWidth
    ptF.Y = ptF.Y * TwipsPerPixelY + .Top + lgCaptionHeight + lgSectionHieghts
    'Adjust by 120 twips.   This may be an accumalation of borderwidths??
    ptF.X = ptF.X - 120: ptF.Y = ptF.Y - 120
    'Pass the control's position and size back in rcBtn
    SetRect rcBtn, ptF.X, ptF.Y, ptF.X + .Width, ptF.Y + .Height
End With
End Sub

Public Sub GetPixelsXY()
'Gets screen twips per pixel in X and Y
Dim lgDC As Long, lgHwnd As Long
lgHwnd = GetDesktopWindow
lgDC = GetDC(lgHwnd)
TwipsPerPixelX = 1440 / GetDeviceCaps(lgDC, LOGPIXELSX)
TwipsPerPixelY = 1440 / GetDeviceCaps(lgDC, LOGPIXELSY)
ReleaseDC lgHwnd, lgDC
End Sub

Private Sub GetCursorPosition(ptCur As POINTAPI, ByVal MDIHwnd As Long)
Dim dl As Long
'Get cursor position and convert to MDIClient coordinates
dl = GetCursorPos(ptCur)
dl = ScreenToClient(MDIHwnd, ptCur)
'Convert cursor position to twips
ptCur.X = ptCur.X * TwipsPerPixelX
ptCur.Y = ptCur.Y * TwipsPerPixelY
End Sub

Private Function GetMDIClientHwnd() As Long
'Returns the handle of Access's MDI background
Dim lgHwnd As Long, stName As String
lgHwnd = GetWindow(Application.hWndAccessApp, GW_CHILD)
'Get class name of child windows
Do
    stName = GetClassName(lgHwnd)
    If LCase(stName) = "mdiclient" Then
        GetMDIClientHwnd = lgHwnd
        Exit Function
    End If
    lgHwnd = GetWindow(lgHwnd, GW_HWNDNEXT)
Loop While lgHwnd <> 0
End Function

Private Function GetClassName(ByVal lgHwnd As Long)
Dim stBuf As String, dl As Long
'Initialize space
stBuf = String$(255, 0)
dl = GetClassNameApi(lgHwnd, stBuf, 255)
If InStr(stBuf, Chr$(0)) Then stBuf = Left$(stBuf, InStr(stBuf, Chr$(0)) - 1)
GetClassName = stBuf
End Function

Private Function SectionHieghts(frm As Form, itSec As AcSection) As Long
'Returns the combined hieght of a form's visble sections
Dim lgHeight As Long
On Error Resume Next
With frm
    If itSec = acDetail Then
        If .Section(acHeader).Visible Then
            lgHeight = .Section(acHeader).Height
        End If
    End If
    If itSec = acFooter Then
        If .Section(acHeader).Visible Then
            lgHeight = .Section(acHeader).Height
        End If
        lgHeight = lgHeight + .Section(acDetail).Height
    End If
End With
SectionHieghts = lgHeight
End Function

gaw

This will take me a little while to check out, and I'm out of the office all this week, so bear with me while I test it...

Cheers

gwgaw, (BLOODY) brilliant. Although not the original questioner, I have watched this topic with interest as I had a system that (nearly exactly) required the same sort of functionality (continuous form), but which I had eventually given up as too hard/impossible to have work.

Using your (final) posted code, I now have it working.

I did get an initial compile error on your line:

Private Function SectionHieghts(frm As Form, itSec As AcSection) As Long

which I changed to :

Private Function SectionHieghts(frm As Form, itSec As Integer) As Long

and error went away (I was in Access97), but other than that, (again) BLOODY brilliant.

If you like, post another question directly to me. and I will give you the points as well, as this has certainly been of enormous help to me, and will become (another) of my (called) "standard routines"

Thanks archery, glad you could use it.

After further testing I have found that the method I used for the selector width may return an incorrect value. However, I also found that the selctor width is always 285 twips regardless of screen resulotion or user preferences for appearance.

Change the following section of code from...

If .RecordSelectors Then
   lgSelectorWidth = .InsideWidth - .Width
End If

to...

If .RecordSelectors Then
   lgSelectorWidth = 285
End If

gaw

Does exactly what it says on the tin - cheers gaw

Don't know if anyone is still watching this, but:

After testing this further, I found a problem with subforms which have horizontal scroll bars, as the code does not allow for the horizontal offset.  However, if you change the line

    lgLeft = .Left + lgSelectorWidth

to

    lgLeft = .Left + lgSelectorWidth + sfForm.CurrentSectionLeft

in the WhichTextBox function then it will work in this case too.

Cheers
Belazir

Belazir:

Thanks for the updates!

Joe

This is a very good solution

BUT
There is a problem if I need to let the user to use the Click event
for example:
if I dispaly  a form with ctlMyWebSite control
and I set the onClick to goto that web site
Then this solution you send will always do the onClick Evnet

Doron

I did find some way to overcome the problem I wrote above

But found a new problem if the Control we want to use is Enable=No and Locked=Yes, then mouse click will not work, I Think we have to find a way to change the current record to the one the mouse is over without using the click event

Well Here is the solution for the Click event Problem

we sould add Public var:
Public bIgnoreMouseClick As Boolean 'Set To True when the mouse_event is used and to False after the event if Done

I have changed The MouseMove sub & Add an Click event Example

Hope it help
Doron

Private Sub MyName_Click()
    If Not bIgnoreMouseClick Then
        Call MsgBox("You Clicked Me")
    End If
End Sub
 
Private Sub MyName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    Dim pt As POINTAPI  'Cursor position
    Dim rc As RECT      'Position and size of the current row's textbox under the cursor
    If Not bIgnoreMouseClick Then
        bIgnoreMouseClick = True
        WhichTextBox Me, MyName, Y, pt, rc
        If PtInRect(oldRC, pt.X, pt.Y) = 0 Then
           mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
           oldRC = rc
            stTip = "Whatever you want " & Me.MyName.Value
            'This will prevent flickering by setting the tip text only when it changes
            If MyName.ControlTipText <> stTip Then
                Me.MyName.ControlTipText = stTip
            End If
            DoEvents
        End If
        bIgnoreMouseClick = False
    End If
End Sub

Select allOpen in new window