|
|
This function uses the RtlMoveMemory API to determine if a given control is the screen's ActiveControl. The RtlMoveMemory function was used to save extensive name and form heirarchy comparisons that would be otherwise required to accurately determine whether the control references point to the same control. The function compares the object pointers for both the Screen.ActiveControl reference as well as the passed control reference. If the two pointers are identical, each reference points to the same control. Similar functionality can be obtain by using the undocumented ObjPtr() VBA function, however it is undocumented. This method is fully supported via the Win32 API and VBA. This function is valid on 64 bit machines, but is restricted to 32 bit installations of Access. The pointer size will need to be re-determined for use with 64 bit Access. CODE ' IsActiveControl ' http://www.utteraccess.com/wiki/index.php/IsActiveControl ' Code courtesy of UtterAccess Wiki ' Licensed under Creative Commons License ' http://creativecommons.org/licenses/by-sa/3.0/ ' ' You are free to use this code in any application, ' provided this notice is left unchanged. ' ' rev date brief descripton ' 1.0 2011-09-02 ' Public Function IsActiveControl(ctl As Control) As Boolean Dim ret As Boolean 'You must copy/paste the following API declaration in the Declarations 'section of this module: ' 'Private Declare Sub RtlMoveMemory Lib "kernel32" _ ' (dest As Any, source As Any, ByVal bytes As Long) Const PTR_SIZE = 4 Dim o As Object Dim ptrAct As Long 'active control ptr Dim ptrCtl As Long 'control ptr On Error Resume Next Set o = Screen.ActiveControl If Not (o Is Nothing) Then RtlMoveMemory ptrAct, o, PTR_SIZE RtlMoveMemory ptrCtl, ctl, PTR_SIZE If ptrAct = ptrCtl Then ret = True End If IsActiveControl = ret End Function
CODE Public Function IsActiveControl(ctl As Control) As Boolean
' IsActiveControl ' http://www.utteraccess.com/wiki/index.php/IsActiveControl ' Code courtesy of UtterAccess Wiki ' Licensed under Creative Commons License ' http://creativecommons.org/licenses/by-sa/3.0/ ' ' You are free to use this code in any application, ' provided this notice is left unchanged. ' Posted 13/08/2012 IsActiveControl = Screen.ActiveControl Is ctl End Function This has not been tested in 64-bit OS / 64-bit Access but I expect it to work since it relies completely on the inbuilt Access VBA.
|
| This page has been accessed 1,286 times. This page was last modified 12:22, 13 August 2012 by vtd. Contributions by Jack Leach Disclaimers |