[AccessD] events question

Jim Lawrence accessd at shaw.ca
Thu Dec 13 07:36:53 CST 2007


Very concise Gustav.

Jim

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Wednesday, December 12, 2007 3:26 AM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] events question

Hi AD and Susan

But this is just so much easier to achieve using WithEvents. Shamil told me
once how to do it, and this method is much more flexible and powerful.
And everyone who can create a code module can join the game! A real
eye-opener if WithEvents is new to you.

For your convenience, I have pasted three textfiles you can load into an
empty database with these three commands in the imm. window to create a
working demo in one minute:

LoadFromText acModule, "CTxtHighlight", "d:\path\CTxtHighlight.txt"
LoadFromText acModule, "CTxtMouseMove", "d:\path\CTxtMouseMove.txt"
LoadFromText acForm, "frmMouseHighlightTest",
"d:\path\frmMouseHighlightTest.txt"

where you, of course, will have to adjust "d:\path" to your location of the
files.
Compile and save all modules, open the form and voila!
Note that MouseMove controls the focus, while the focus controls the back
colour.

/gustav

Copy and paste into Notepad and save these three files:

--- CTxtHighlight.txt:
Attribute VB_Creatable = True
Option Compare Database
Option Explicit

Private Const mcstrModuleName As String = "CTxtHighlight"

Private Const mclngHighlightColor As Long = 16776960

Private WithEvents mtxt As Access.TextBox

Private mlngDefaultColor As Long

Public Sub Init(ByRef rtxt As Access.TextBox)
  
  Const cstrEVP = "[Event procedure]"
  
  Set mtxt = rtxt
  
  mtxt.OnGotFocus = cstrEVP
  mtxt.OnLostFocus = cstrEVP

End Sub

Public Sub Terminate()
  
  Set mtxt = Nothing

End Sub

Private Sub mtxt_GotFocus()
  
  mlngDefaultColor = mtxt.BackColor
  mtxt.BackColor = mclngHighlightColor

End Sub

Private Sub mtxt_LostFocus()
  
  mtxt.BackColor = mlngDefaultColor

End Sub
---

--- CTxtMouseMove.txt:
Attribute VB_Creatable = True
Option Compare Database
Option Explicit

Private Const cstrModuleName As String = "CTxtMouseMove"

Private WithEvents mtxt As Access.TextBox

Private msngLastX As Single
Private msngLastY As Single

Public Sub Init(ByRef rtxt As Access.TextBox)
  
  Const cstrEVP = "[Event procedure]"
  
  Set mtxt = rtxt
  
  mtxt.OnMouseMove = cstrEVP

End Sub

Public Sub Terminate()
  
  Set mtxt = Nothing

End Sub

Private Sub mtxt_MouseMove(Button As Integer, Shift As Integer, x As Single,
Y As Single)

  On Error GoTo mtxt_MouseMove_Err
  
  If msngLastX <> x Or msngLastY <> Y Then
    If Access.Screen.ActiveControl.Name <> mtxt.Name Then
      mtxt.SetFocus
    End If
  End If
  msngLastX = x
  msngLastY = Y

mtxt_MouseMove_Err:

End Sub
---

--- frmMouseHighlightTest.txt:
Version = 17
VersionRequired = 17
Checksum = 1901948613
Begin Form
    RecordSelectors = NotDefault
    MaxButton = NotDefault
    MinButton = NotDefault
    NavigationButtons = NotDefault
    DefaultView = 0
    ScrollBars = 0
    ViewsAllowed = 1
    PictureAlignment = 2
    DatasheetGridlinesBehavior = 3
    GridX = 12
    Width = 4818
    DatasheetFontHeight = 10
    ItemSuffix = 5
    Left = 600
    Top = 330
    Right = 8970
    Bottom = 4560
    DatasheetGridlinesColor = 12632256
    OnUnload ="[Event Procedure]"
    RecSrcDt = Begin
        0xe1f47db2cbcee140
    End
    DatasheetFontName ="Arial"
    OnLoad ="[Event Procedure]"
    Begin
        Begin Label
            BackStyle = 0
        End
        Begin TextBox
            SpecialEffect = 2
            OldBorderStyle = 0
        End
        Begin Section
            Height = 2267
            BackColor = 12632256
            Name ="Detaljesektion"
            Begin
                Begin TextBox
                    OverlapFlags = 85
                    Left = 2503
                    Top = 1039
                    Width = 1134
                    Height = 236
                    Name ="txt1"
                    Begin
                        Begin Label
                            OverlapFlags = 85
                            Left = 1370
                            Top = 1039
                            Width = 850
                            Height = 236
                            Name ="Etiket1"
                            Caption ="TextBox1"
                        End
                    End
                End
                Begin TextBox
                    OverlapFlags = 85
                    Left = 2503
                    Top = 1464
                    Width = 1134
                    Height = 236
                    TabIndex = 1
                    Name ="txt2"
                    Begin
                        Begin Label
                            OverlapFlags = 85
                            Left = 1370
                            Top = 1464
                            Width = 850
                            Height = 236
                            Name ="Etiket3"
                            Caption ="TextBox2"
                        End
                    End
                End
                Begin Label
                    BackStyle = 1
                    OldBorderStyle = 1
                    OverlapFlags = 85
                    Left = 806
                    Top = 188
                    Width = 3162
                    Height = 426
                    BackColor = 10092543
                    BorderColor = 16776960
                    Name ="Etiket4"
                    Caption ="Move the mouse or type Tab. \015\012Focus and
BackColor will follow."
                End
            End
        End
    End
End
CodeBehindForm
Option Compare Database
Option Explicit

Private mcol As Collection

Private Sub Form_Load()
  
  Dim obj As Object
  Dim ctl As Access.Control
  
  Set mcol = New Collection

  For Each ctl In Me.Controls
    If TypeName(ctl) = "TextBox" Then
      
      Set obj = New CTxtMouseMove
      obj.Init ctl
      mcol.Add obj, "MM" & ctl.Name

      Set obj = New CTxtHighlight
      obj.Init ctl
      mcol.Add obj, "HL" & ctl.Name
    
    End If
  Next
  
  Set ctl = Nothing
  Set obj = Nothing

End Sub

Private Sub Form_Unload(Cancel As Integer)
  
  Dim eobj As Object

  For Each eobj In mcol
    eobj.Terminate
  Next eobj
  
  Set eobj = Nothing
  Set mcol = Nothing

End Sub
---

/gustav


>>> adtp at airtelbroadband.in 11-12-2007 18:53 >>>
Using common function for MouseMove over multiple controls
==========================================

    1 - MouseMove over a given control does not necessarily imply that the
control in question is the active control. This rules out the use of an
omnibus function based upon ActiveControl. Instead, it becomes necessary
that even if a common function of generic nature is used for all controls,
name of each individual control making the call has to be passed as an
argument.

    2 - Evidently, conventional approach in calling such a function from
MouseMove events of multiple controls involves tedious work by the
developer. Repetitive entries of function name (with control name as
argument) are needed either in VBA code in MouseMove event for each of the
controls in question, or directly as similar entries against OnMouseMove
property on Event tab in properties dialog box of each such control.

    3 - An interesting alternative that makes the whole process remarkably
simpler, is suggested below:

    3.1 - With form in design view, select all controls required to make use
of the common function. Set the tag property of these controls to "MM"
(simply enter MM without any enclosing quotes).  Save.

    3.2 - Go to VBA window and place the sample code as given below, in
form's module. Save and compile. Come out of VBA window, save and close the
form.

    3.3 - As the form loads, OnMouseMove event property of all the above
controls will get set to function Fn_MMove(), correctly passing the name of
control as argument in each case. 

    3.4 - As per the common function Fn_MMove() given below, back color of
all the above text boxes (having "MM" as the tag property) will change to
red on mouse move.

A.D.Tejpal
------------

Sample code in form's module
'==================================
Private Sub Form_Load()
    On Error Resume Next
    Dim ct As Control
    
    For Each ct In Me.Controls
        If ct.Tag = "MM" Then
            ct.OnMouseMove = _
                "=Fn_MMove('" & ct.Name & "')"
        End If
    Next
    On Error GoTo 0
End Sub
'--------------------------------------------------

Private Function Fn_MMove(StrTxtBoxName As String)
    Me(StrTxtBoxName).BackColor = vbRed
End Function
'==================================

  ----- Original Message ----- 
  From: Susan Harkins 
  To: AccessD at databaseadvisors.com 
  Sent: Friday, December 07, 2007 21:24
  Subject: [AccessD] events question


  I don't know how to summarize this question, hence the bad subject. I 
  apologize.

  I'm wondering if there's a way to consolidate similar event calls into one

  event. For instance, if you want to passto/call a function from every 
  control's Mouse Over event, is there a simple way to do that with one call

  rather than dropping the call into every single control's appropriate
event?

  I've run into this so many times and it just seems so inefficient.

  Susan  H.


-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com




More information about the AccessD mailing list