ACCESS VBA - Track mouse cursor in continuous subform

So, as the title says: i need to be able to track the mouse over a continuous subform and, with the help of a textbox called [BackRow], highlight the row under mouse. So far i've tried (and got it to work - almost): i used a transparent button called [Selector] who's OnMouseMove event i use to detect where the cursor is like so:

  1. using GetCursorPos i find where the cursor is in respect to the desktop;
  2. using ScreenToClient i update the resulting POINTAPI to get the real X and Y
  3. using GetScrollInfo i find the position of the scroll bar
  4. knowing the height of the detail section and the scroll bar postition it's quite easy to calculate the AbsolutePostion for the underlying recordset and then, using a clone so i don't mess with it, i get the ID number.
  5. i set the absoulte position for the original recordset
  6. i put this ID on a unbound textbox on the subform called [CL] and then let the Conditional Format of the [BackRow] textbox do its magic.

Now, this works as inteded, even if with a small lag (less than 0.1s), but the problem is that the CF stops working if i don't have the IDE window open. The status bar gives the ol' "Calculating..." message. If i scroll the continuous form, it works again for a few seconds or rows (i'm not sure yet what the limit is) and then stops. I want to mention that there are NO overlapping controls of any kind on the subform except for the [BackRow] textbox, but i've even tried to address that without any succes.

Also, i want to mention that the subform uses the SetWindowLongPtr api to enable the WS_DOUBLELAYERD attribute for smoother scrolling, although it has the same efect vis-a-vis my issue if i disable it.

Private Sub Selector_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Const CPN = "clsFormAsTable\PositionControls"

On Error GoTo EROARE

Dim I As Integer
Dim PT As POINTAPI
Dim cRow As Long
Set btnUnderMouse = Nothing

If Not ParentForm.RecordSet Is Nothing Then
    If ParentForm.RecordSet.EOF Or ParentForm.RecordSet.BOF Then ParentForm.RecordSet.MoveFirst
    
    If blnTrackMouse Then
        GetCursorPos PT
        ScreenToClient SubformControl.Form.hwnd, PT
    
        If PT.y > 40 And Nz(ParentForm.CL, "") <> "" Then
            If PT.x < listRC.X1 + 40 Or PT.x > listRC.X2 - 40 Or PT.y < listRC.Y1 + 40 Or PT.y > listRC.Y2 - 40 Then
                ParentForm.CLH = ParentForm.CL
                GoTo IESIRE
            End If
        ElseIf PT.y > 40 Then
            GoTo IESIRE
    
        End If
    
        cRow = Int(((PT.y - SubformControl.Form.FormHeader.Height / TwipsPerPixely) / ((Selector.Height + 1) / TwipsPerPixely)) + mMax(1, GetScrollbarPos(SubformControl.Form, stVertical)))
    
        If cRow >= 1 Then
            If cRow <> lngCurrentRow Then
                lngCurrentRow = cRow
                With rstRows.Clone
                    If CLng(.AbsolutePosition) <> lngCurrentRow Then .AbsolutePosition = lngCurrentRow
                    ParentForm.CLH = .Fields(0).value
                    ParentForm.txtFooter = Concat_WS(",", ParentForm.CL, ParentForm.CLH)
                End With
            End If
        End If
    End If
    
End If

IESIRE:
Exit Sub

EROARE:
    DebugPrint "EROARE:" & Err.Description, CPN, True
    Resume IESIRE
End Sub

and the CF part:

With FRM.BackRow.FormatConditions.Add(acExpression, acEqual, "[CL]=[" & rstRows.Fields(0).Name & "]")
    .BackColor = FRM.FormFooter.BackColor
    .ForeColor = 4144959
End With

If blnTrackMouse Then
    With FRM.BackRow.FormatConditions.Add(acExpression, acEqual, "[CLH]=[" & rstRows.Fields(0).Name & "]")
        .BackColor = FRM.PageHeaderSection.BackColor
        .ForeColor = FRM.PageHeaderSection.BackColor
    End With
End If

Upvotes: 0

Views: 278

Answers (0)

Related Questions