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