I'm working on an Access 2007 application and have some concerns about performance with MouseMove over labels and form.
So far with my solution I'm getting high cpu usage on a dual core I5 3.0ghz.
When I move the mouse cpu usage jumps to about 30-32% of one core.(With hyperthreading on)
For such a trivial task as a MouseMove, I'd like to have something a bit more efficient :)
The code below as been shortened; I have 8 labels with MouseMove event handler.
Here's how it's implemented:
Private moveOverOn As Boolean
Private Property Get isMoveOverOn() As Boolean
isMoveOverOn = moveOverOn
End Property
Private Property Let setMoveOverOn(value As Boolean)
moveOverOn = value
End Property
'label MouseMove detection
Private Sub lbl_projects_completed_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = 0 And isMoveOverOn = False Then
Me.lbl_projects_completed.FontBold = True
setMoveOverOn = True
End If
End Sub
'main form MouseMove detection
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If isMoveOverOn Then
resetBold 'call a sub that reset all labels .FontBold
setMoveOverOn = False
End If
End Sub
I don't know if it's possible, but I think that reducing the speed at which the MouseMove
is refreshed would help for this task, unfortunately I wasn't able to find information about it.
I'm opened to suggestions, thanks for your time! :)
The accdb format has hover and press color properties for buttons, so if you don't mind converting to that format and the labels could be buttons that should work much better than what you have going on.
Okay so this will do what you want with less of an expense but just know mouse move does not update X,Y when over a control so it has intermittent issues with the event.
This is custom implementation of a mouseHover event using mouse move on the detail section so it is only called 1 time. It then loops through the controls (you can change this loop to only look at controls you want) and sees if the cursor is within 5 twips of the control on any side
It also accepts a fuzziness parameter because of the lack of updating when over a control. The default it 50 twips. Also know that the controls should be shrunk to the minimum size possible to fit the data as this function uses the controls height and width to determine if you are inside of the control.
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
mouseHover X, Y
End Sub
Private Sub mouseHover(X As Single, Y As Single)
Dim ctrl As Control
'You may want to make an array of controls here to shorten the loop
'i.e.
' Dim ctrl_array() As Variant
' ctrl_array(0) = Me.lbl_projects_completed
' ctrl_array(1) = Me.some_other_label
' For Each ctrl in ctrl_array
For Each ctrl In Me.Controls
If ctrl.ControlType = acLabel Then
If FuzzyInsideControl(ctrl.top, ctrl.left, ctrl.width, ctrl.height, X, Y) Then
ctrl.FontBold = True
ctrl.ForeColor = RGB(255, 0, 0)
Exit For
Else
ctrl.ForeColor = RGB(0, 0, 0)
ctrl.FontBold = False
End If
End If
Next ctrl
End Sub
Private Function FuzzyInsideControl(top As Long, left As Long, width As Long, height As Long, X As Single, Y As Single, Optional fuzz As Integer = 50) As Boolean
Dim coord_left As Long
Dim coord_right As Long
Dim coord_top As Long
Dim coord_bottom As Long
Dim inside_x As Boolean
Dim inside_y As Boolean
coord_top = top - fuzz
coord_bottom = top + height + fuzz
coord_left = left - fuzz
coord_right = left + width + fuzz
inside_y = Y > coord_top And Y < coord_bottom
inside_x = X > coord_left And X < coord_right
FuzzyInsideControl = inside_x And inside_y
End Function
While I still think that this is unnecessary it was an interesting question and fun to work with but there are some of limitations due to how mouseMove works
Edit
Changed the FuzzyInsideControl function for a cleaner more concise version should be more accurate although I will have to test tomorrow when I get back to a computer with access.
Finally I found what I was looking for to reduce the MouseMove strain on the CPU:
'put this in head of the form code
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'form MouseMove with sleep timer
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'placeholder call sub to change the label FontBold Suggested by engineersmnky
Sleep (25)
End Sub
Related
I am trying to get the DB to close after 2 minutes have passed by (for testing purposes I am just making a MsgBox appear after the 2 minutes). To do this, I have a main form called DTForm and a hidden form called Timer. Both forms open on opening the DB but Timer opens in hidden mode.
AutoExec Macro:
1. Open DTForm (the main form)
2. Open Timer (the hidden form)
Module 1:
Option Compare Database
Option Explicit
Public timer_start As Date
Public timer_end As Date
Public timer_diff As Integer
DTForm (users will only see this form)
Option Compare Database
Option Explicit
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_start = Time
timer_end = DateAdd("n", 2, timer_start)
End Sub
Timer (the hidden form):
Option Compare Database
Option Explicit
Public Sub Form_Open(Cancel As Integer)
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End Sub
Public Sub Form_Load()
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End Sub
Public Sub Form_Timer()
timer_diff = DateDiff("n", timer_end, Time)
If timer_diff >= 0 Then
'Application.Quit
MsgBox "timer reached 0"
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End If
End Sub
Update - the problem: So now the problem is the mouse. It looks like just moving the mouse around the form does nothing. However, moving the mouse from the navigation pane to the form and back (in and out) does trigger the mouse movement. This seems really counter-intuitive - why not just consider all mouse movements?
Notes: Added Option Explicit to the tops of both forms and fixed some missing variable declarations.
This seems to be a variable scope issue to me. By default your variables are local.
Unless timer_end is declared as a global or public variable, it is out of scope as soon as you leave the sub where it is defined. So the timer_end in Form_timer is a totally different variable than the one in your MouseMove event (even though they have the same name).
This is one reason why many people put "option explicit" at the beginning of their code as it forces you to declare your variables.
You could also pursue a design strategy where you pass the variable as a parameter instead of making it global or public
If you want to go through with it, the Form_MouseMove event must be in every form, because only the active form receives the MouseMove event.
Note: you actually don't need the timer_start variable at all. You can remove it and keep only:
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_end = DateAdd("n", 2, Time)
End Sub
Or somewhat cleaner:
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UpdateTimer()
End Sub
and in your Module1:
Public Sub UpdateTimer()
timer_end = DateAdd("n", 2, Time)
End Sub
in case you decide to change the time interval...
Note:
timer_diff should be a local variable in Timer.Form_Timer(), since it's only used there.
DateDiff("s", timer_end, Time) will return a negative value until the 10 seconds of inactivity, then the condition must be changed to >= and the time interval to 1000 (1 second) 1 millisecond is too fast.
Also to make sure the variables are ok add option explicit clause
Option Compare Database
Option Explicit
Dim timer_start as Variant
Dim timer_end as Variant
Public Sub Form_Open(Cancel As Integer)
timer_start = Time
End Sub
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_start = Time
timer_end = DateAdd("s", 10, timer_start)
Me.Label6.Caption = timer_start
Me.Label8.Caption = timer_end
End Sub
Public Sub Form_Timer()
If DateDiff("s", timer_end, Time) >= 0 Then
MsgBox "timer reached 0"
End If
End Sub
i want to display a character in an inputbox: dot . on click and dash - on long click. For instance, holding left click for 2 seconds will display dash instead of dot.
i have tried this on double click, here is my code:
Private Sub input_Click()
Me.input.Value = "." + Me.input.Value
End Sub
Private Sub input_DblClick(Cancel As Integer)
Me.input.Value = "-" + Me.input.Value
End Sub
the problem here is that when i double click it will pass thru click and display dot and dash when it is suppose to display dash only.
i'd like to add that i need to use only left click on this. no keyboard, no right click.
that's why my idea is to use either click for dot and double click for dash, or click and long click.
I have an idea of having if statement on VBA and check if its a single click or double without using the double click event.
Define in the header of form's module the following variables:
Private isMouseKeyPreessed As Boolean
Private timeMouseKeyPreessed As Date
then define MouseUp and MouseDown events for textbox named input (by the way it is bad name, because input is reserved word):
Private Sub input_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
isMouseKeyPreessed = True
timeMouseKeyPreessed = Now
End If
End Sub
Private Sub input_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Delta As Double
Dim symbol As String
If Button = acLeftButton Then
isMouseKeyPreessed = False
Delta = Now - timeMouseKeyPreessed
If Delta > 0.00002 Then
' 0.00002 - is a value to tune up to get exactly 2 seconds
' it should be about
' cdbl(timeserial(0,0,2)-timeserial(0,0,0))
symbol = "-"
Else
symbol = "."
End If
Me.input.Value = symbol & Me.input.Value
End If
End Sub
First time posting on this website; mainly because I'm running into a huge issue with a question on my visual basic class that we were assigned. The full question can be seen here.
Basically, I'm running into issues where I THINK I am correctly executing the Buckling Load function as instructed, but I don't know how to get each different True or False value into the lstOut box.
Public Class Form1
Private Sub btnCompute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCompute.Click
Dim area As Double
Dim length As Double
Dim width As Double
Dim load As Double
Dim buckling1 As String
Dim buckling2 As String
Dim buckling3 As String
length = CDbl(txtIn.Text)
load = CDbl(txtLbs.Text)
buckling1 = Test1(load, length, 2, area)
buckling2 = Test1(load, length, 4, area)
buckling3 = Test1(load, length, 6, area)
End Sub
Private Function Test1(ByVal load As Double, ByVal length As Double, ByVal width As Double, ByVal area As Double) As Boolean
If ((0.3 * 1700000 * (length * width)) / (length / width) ^ 2) > load Then
Return True
Else
Return False
End If
End Function
End Class
And that's only the first part...I'm really struggling with this question. I'm somewhat new to programming, and the concept of functions are pretty frightening. Does anyone have any tips or advice they could give me?
Note that I'm not asking for the whole question to be completed, I'm just trying to figure out how I'm going to put all of output from the Test1, Test2, and Test3 functions into the lstOut box. I hope I'm making at least some sense.
You can set the buckling variables to Boolean as Suggested by Mark Hall, or pass the words "True" or "False" instead as string so that your Buckling variables accept them
IE simply add Double Quote(s) to True (turning it to "True") and False (turning it to "False")
I have memo field and list. What I want to accomplish is if I am typing something in memo field and then just click on text record in list that the text shows up in memo positioned with the beginning where cursor was.
After research, and googling I succeed to make it. I did it with .selstart property.
But for me it seems that selstart has bug. It works only if I click somewhere in memo (Then everything works great.) But if was typing something, and then click on text in list (without previously clicking in memo field) selstart returns position 0.
This makes me huge problem.
Can anyone help? Thank you.
As you found out, the problem is that the cursor position is lost when you move away from the memo.
This is probably due to the fact that Access form controls are not "real" controls: they are real windows controls only when they have the focus. the rest of the time, they are sort of images of the control pasted onto the form.
So, what you need to do is track the cursor position (and currently selected length of text) during various interractions:
when the user moves the cursor using the keyboard (KeyUp event)
when the user clicks inside the memo (Click event, to position the cursor or select text using the mouse)
when the memo initially gets the focus (GetFocus, the first time, the whole text is selected and the cursor is at position 0)
To test this, I made a small form:
The added the following code to the form:
'----------------------------------------------------------
' Track the position of the cursor in the memo
'----------------------------------------------------------
Private currentPosition As Long
Private currentSelLen As Long
Private Sub txtMemo_Click()
RecordCursorPosition
End Sub
Private Sub txtMemo_GotFocus()
RecordCursorPosition
End Sub
Private Sub txtMemo_KeyUp(KeyCode As Integer, Shift As Integer)
RecordCursorPosition
End Sub
Private Sub RecordCursorPosition()
currentPosition = txtMemo.SelStart
currentSelLen = txtMemo.SelLength
End Sub
'----------------------------------------------------------
' Insert when the user double-click the listbox or press the button
'----------------------------------------------------------
Private Sub listSnippets_DblClick(Cancel As Integer)
InsertText
End Sub
Private Sub btInsert_Click()
InsertText
End Sub
'----------------------------------------------------------
' Do the actual insertion of text
'----------------------------------------------------------
Private Sub InsertText()
If Len(Nz(listSnippets.Value, vbNullString)) = 0 Then Exit Sub
Echo False 'Avoid flickering during update
' Update the Memo content
Dim oldstr As String
oldstr = Nz(txtMemo.Value, vbNullString)
If Len(oldstr) = 0 Then
txtMemo.Value = listSnippets.Value
Else
txtMemo.Value = Left$(oldstr, currentPosition) & _
listSnippets.Value & _
Mid$(oldstr, currentPosition + currentSelLen + 1)
End If
'We will place the cursor after the inserted text
Dim newposition As Long
newposition = currentPosition + Len(listSnippets.Value)
txtMemo.SetFocus
txtMemo.SelStart = newposition
txtMemo.SelLength = 0
currentPosition = newposition
currentSelLen = 0
Echo True
End Sub
I have made a test accdb database that you can download so you can see the details and play around with this.
I have a form which includes a data sheet. I would like to make it possible for a user to select multiple rows, click on a button and have some sql query run and perform some work on those rows.
Looking through my VBA code, I see how I can access the last selected record using the CurrentRecord property. Yet I don't see how I can know which rows were selected in a multiple selection. (I hope I'm clear...)
What's the standard way of doing this? Access VBA documentation is somewhat obscure on the net...
Thanks!
I used the technique similar to JohnFx
To trap the Selection height before it disappears I used the Exit event of the subform control in the Main form.
So in the Main form:
Private Sub MySubForm_Exit(Cancel As Integer)
With MySubForm.Form
m_SelNumRecs = .SelHeight
m_SelTopRec = .SelTop
m_CurrentRec = .CurrentRecord
End With
End Sub
Here is the code to do it, but there is a catch.
Private Sub Command1_Click()
Dim i As Long
Dim RS As Recordset
Dim F As Form
Set F = Me.sf.Form
Set RS = F.RecordsetClone
If F.SelHeight = 0 Then Exit Sub
' Move to the first selected record.
RS.Move F.SelTop - 1
For i = 1 To F.SelHeight
MsgBox RS![myfield]
RS.MoveNext
Next i
End Sub
Here's the catch:
If the code is added to a button, as soon as the user clicks that button, the selection is lost in the grid (selheight will be zero). So you need to capture that info and save it to a module level variable either with a timer or other events on the form.
Here is an article describing how to work around the catch in some detail.
http://www.mvps.org/access/forms/frm0033.htm
Catch 2: This only works with contiguous selections. They can't select mutliple non-sequential rows in the grid.
Update:
There might be a better event to trap this, but here is a working implementation using the form.timerinterval property that i have tested (at least in Access 2k3, but 2k7 should work just fine)
This code goes in the SUBFORM, use the property to get the selheight value in the master form.
Public m_save_selheight As Integer
Public Property Get save_selheight() As Integer
save_selheight = m_save_selheight
End Property
Private Sub Form_Open(Cancel As Integer)
Me.TimerInterval = 500
End Sub
Private Sub Form_Timer()
m_save_selheight = Me.selheight
End Sub
I've tried doing something like that before, but I never had any success with using a method that required the user to select multiple rows in the same style as a Windows File Dialog box (pressing Ctrl, Shift, etc.).
One method I've used is to use two list boxes. The user can double click on an item in the left list box or click a button when an item is selected, and it will move to the right list box.
Another option is to use a local table that is populated with your source data plus boolean values represented as checkboxes in a subform. After the user selects which data they want by clicking on checkboxes, the user presses a button (or some other event), at which time you go directly to the underlying table of data and query only those rows that were checked. I think this option is the best, though it requires a little bit of code to work properly.
Even in Access, I find sometimes it's easier to work with the tables and queries directly rather than trying to use the built-in tools in Access forms. Sometimes the built-in tools don't do exactly what you want.
A workaround to the selection loss when the sub form loses the focus is to save the selection in the Exit event (as already mentioned by others).
A nice addition is to restore it immediately, using timer, so that the user is still able to see the selection he made.
Note: If you want to use the selection in a button handler, the selection may not be restored already when it executes. Make sure to use the saved values from the variables or add a DoEvents at the beginning of the button handler to let the timer handler execute first.
Dim m_iOperSelLeft As Integer
Dim m_iSelTop As Integer
Dim m_iSelWidth As Integer
Dim m_iSelHeight As Integer
Private Sub MySubForm_Exit(Cancel As Integer)
m_iSelLeft = MySubForm.Form.SelLeft
m_iSelTop = MySubForm.Form.SelTop
m_iSelWidth = MySubForm.Form.SelWidth
m_iSelHeight = MySubForm.Form.SelHeight
TimerInterval = 1
End Sub
Private Sub Form_Timer()
TimerInterval = 0
MySubForm.Form.SelLeft = m_iSelLeft - 1
MySubForm.Form.SelTop = m_iSelTop
MySubForm.Form.SelWidth = m_iSelWidth
MySubForm.Form.SelHeight = m_iSelHeight
End Sub
There is another solution.
The code below will show the number of selected rows as soon as you release the mouse button.
Saving this value will do the trick.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox Me.SelHeight
End Sub
Use a Global variable in the form, then refer to that in the button code.
Dim g_numSelectedRecords as long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_numSelectedRecords = Me.SelHeight
End Sub
Dim formRecords As DAO.Recordset
Dim i As Long
Set formRecords = Me.RecordsetClone
' Move to the first record in the recordset.
formRecords.MoveFirst
' Move to the first selected record.
formRecords.Move Me.SelTop - 1
For i = 1 To numSelectedRecords
formRecords.Edit
formRecords.Fields("Archived") = True
formRecords.Update
formRecords.MoveNext
Next i
Why not use an array or recordset and then every time the user clicks on a row (either contiguous or not, save that row or some identifier into the recordset. Then when they click the button on the parent form, simply iterate the recordset that was saved to do what you want. Just don't forget to clear the array or recordset after the button is clicked.?
Another workaround to keeping the selection while attempting to execute a procedure - Instead of leaving the datasheet to activate a button, just use the OnKeyDown event and define a specific keycode and shift combination to execute your code.
The code provided by JohnFx works well. I implemented it without a timer this way (MS-Access 2003):
1- Set the Form's Key Preview to Yes
2- put the code in a function
3- set the event OnKeyUp and OnMouseUp to call the function.
Option Compare Database
Option Explicit
Dim rowSelected() As String
Private Sub Form_Load()
'initialize array
ReDim rowSelected(0, 2)
End Sub
Private Sub Form_Current()
' if cursor place on a different record after a selection was made
' the selection is no longer valid
If "" <> rowSelected(0, 2) Then
If Me.Recordset.AbsolutePosition <> rowSelected(0, 2) Then
rowSelected(0, 0) = ""
rowSelected(0, 1) = ""
rowSelected(0, 2) = ""
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
rowsSelected
If KeyCode = vbKeyDelete And Me.SelHeight > 0 Then
removeRows
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
rowsSelected
End Sub
Sub rowsSelected()
Dim i As Long, rs As DAO.Recordset, selH As Long, selT As Long
selH = Me.SelHeight
selT = Me.SelTop - 1
If selH = 0 Then
ReDim rowSelected(0, 2)
Exit Sub
Else
ReDim rowSelected(selH, 2)
rowSelected(0, 0) = selT
rowSelected(0, 1) = selH
rowSelected(0, 2) = Me.Recordset.AbsolutePosition ' for repositioning
Set rs = Me.RecordsetClone
rs.MoveFirst ' other key touched caused the pointer to shift
rs.Move selT
For i = 1 To selH
rowSelected(i, 0) = rs!PositionNumber
rowSelected(i, 1) = Nz(rs!CurrentMbr)
rowSelected(i, 2) = Nz(rs!FutureMbr)
rs.MoveNext
Next
Set rs = Nothing
Debug.Print selH & " rows selected starting at " & selT
End If
End Sub
Sub removeRows()
' remove rows in underlying table using collected criteria in rowSelected()
Me.Requery
' reposition cursor
End Sub
Private Sub cmdRemRows_Click()
If Val(rowSelected(0, 1)) > 0 Then
removeRows
Else
MsgBox "To remove row(s) select one or more sequential records using the record selector on the left side."
End If
End Sub