I have a working 3D object viewer in VB.net (I know that VB.net is not the best language to use for this but still)
So if I press the W key the box moves up. If I press the D key it moves to the right. But I wanna do the simultaneously. And to do so I figured that I could give each key its own thread.
So the is the code I wound upwith.
Dim thread1 As System.Threading.Thread
Dim thread2 As System.Threading.Thread
Private Sub MoveUp_Keydown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles GlControl1.KeyDown
If e.KeyCode = Keys.W Then
If NumericUpDown1.Value < 100 Then
NumericUpDown1.Value = NumericUpDown1.Value + 1
Me.Refresh()
End If
End If
End Sub
Private Sub MoveUp1_Keydown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles GlControl1.KeyDown
If e.KeyCode = Keys.W Then
thread1 = New System.Threading.Thread(AddressOf MoveUp_Keydown)
End If
End Sub
But the error I am getting is
error BC30518: Overload resolution failed because no accessible 'New' can be called with these arguments
I have tried to google this but the problem is that nobody uses the threading for a keypress resulting in different solutions.
Thanks for any help
You can do it without a Timer, but still using the GetKeyState() API:
Public Class Form1
<Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=Runtime.InteropServices.CharSet.Unicode)> _
Private Shared Function GetKeyState(ByVal nVirtKey As Integer) As Short
End Function
Private Sub Form1_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If IsKeyDown(Keys.W) Then
If NumericUpDown1.Value < 100 Then
NumericUpDown1.Value = NumericUpDown1.Value + 1
Me.Refresh()
End If
End If
If IsKeyDown(Keys.D) Then
If NumericUpDown2.Value < 100 Then
NumericUpDown2.Value = NumericUpDown2.Value + 1
Me.Refresh()
End If
End If
' ...etc...
End Sub
Private Function IsKeyDown(ByVal key As Keys) As Boolean
Return GetKeyState(key) < 0
End Function
End Class
The KeyDown() event will fire when any key is being held down, and you simply check each key you're interested in with GetKeyState(). There is no need for multiple threads...and I'm not even sure how that would work with form events. I don't know what you wanted to do with the "D" key, so I just put in NumericUpDown2 so you could see each block can do a different thing. You might not want to call Me.Refresh until the very bottom of the KeyDown() event so it only gets called once.
Related
My VB.NET winforms app runs a timer which creates a background worker to update the objects in an ObjectListView.
In the timer loop, a number of 'device' objects are added to an observable collection (in the backgroundworker_progresschanged event) and (in the backgroundworker_complete event), I use an OLV.SetObjects(allDevices, true) to populate them.
This all works flawlessly. However, the currently selected items in the OLV are lost during the OLV.setobjects so I need to restore them.
To do this, (in the backgroundworker_complete event), I want to access the selecteditems property of the OLV but I keep getting a "Cross-thread operation not valid: Control 'DeviceListView1' accessed from a thread other than the thread it was created on." All attempts at trying to read the selected listviewitems (either by OLV.selecteditems or a loop reading them from the OLV) fail with the cross-thread exception.
I may misunderstand but I thought I could access GUI elements on the backgroundworker_progresschanged and backgroundworker_complete events?
Here's the relevant code:
The PopulateDevices sub is called when the timer is started and will not run again until a specific time has passed. It runs the RunWorkerAsync of the Worker.
Public Sub PopulateDevices()
' Debug
_UpdateCount += 1
' Pause the Update Timer
UpdateTimer.Stop()
' Get the Starting Time of this Update
StartTime = DateTime.Now
' Stop updating the DeviceListView1 ObjectListView
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.BeginUpdate())
' Clear Existing Devices from the List
AllDevices = New TrulyObservableCollection(Of DeviceItem)
' Get the selected devices
'_SelectedDevices = GetSetSelectedDevices(DeviceListView1)
' Prep the BackgroundWorker
PopulateDevicesWorker = New BackgroundWorker
PopulateDevicesWorker.WorkerReportsProgress = True
' Add the Event Handlers
AddHandler PopulateDevicesWorker.DoWork, AddressOf PopulateDevicesWorkerDoWork
AddHandler PopulateDevicesWorker.ProgressChanged, AddressOf PopulateDevicesWorkerProgressChanged
AddHandler PopulateDevicesWorker.RunWorkerCompleted, AddressOf PopulateDevicesWorkerCompleted
' Start the BackgroundWorker
If Not PopulateDevicesWorker.IsBusy Then
PopulateDevicesWorker.RunWorkerAsync()
End If
End Sub
The worker will read a list of devices from a SQLite DB and (in the progresschanged event) populate an observable collection (AllDevices):
Private Sub PopulateDevicesWorkerDoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs)
' We only continue if the \Clients\_Cache File exists and can be read
If Not File.Exists(CacheFilePath) Then
Exit Sub
End If
' Create a new SQLite Connection & Connect to database
Dim DBC As SQLiteDatabase = OpenDB(CacheFilePath)
If Not IsNothing(DBC) Then
' Count the Rows in the \Clients\_Cache file
Dim RowCount As Integer = CountTableRows(DBC, "_Cache")
' Set the SQL Query
SqlQuery = "SELECT * FROM _Cache WHERE Archived = #Archived"
' Create the SQLite Command
Using SQLitecmd As SQLiteCommand = New SQLiteCommand(SqlQuery, DBC.Connection)
SQLitecmd.Parameters.AddWithValue(String.Empty & "Archived", IIf(fMain.ButtonItem_VIEWARCHIVE.Checked, "True", "False"))
Using SQLiteReader = SQLitecmd.ExecuteReader()
Dim Counter As Integer = 0
' Read All Properties into the Array
While SQLiteReader.Read()
Using DeviceItem As New DeviceItem
With DeviceItem
' Get the Device Info here
End With
' Report progress at regular intervals
PopulateDevicesWorker.ReportProgress(CInt(100 * Counter / RowCount), DeviceItem)
' Increment the Counter (for Progress)
Counter += 1
End Using
End While
End Using
End Using
End If
CloseDB(DBC)
End Sub
Here is the WorkerProgressChanged event. It adds the current device (from the worker) into the observable collection (AlLDevices)
Private Sub PopulateDevicesWorkerProgressChanged(sender As Object, e As ProgressChangedEventArgs)
' Update Status
LabelItem_STATUS.Text = "Working.. (" & e.ProgressPercentage & "%)"
' Add the Device to Collection
AllDevices.Add(TryCast(e.UserState, DeviceItem))
End Sub
The WorkerCompleted event will set the objects in AllDevices to the OLV (DeviceListView1)
Private Sub PopulateDevicesWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) ' Handles PopulateDevicesWorker.RunWorkerCompleted
' This is producing Cross-Thread error
If Not IsNothing(_SelectedDevices) Then
For Each item As ListViewItem In _SelectedDevices
Debug.Print(item.Text)
Next
End If
' Populate the ObjectListView
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.SetObjects(AllDevices, True))
' Re-enable Form Updates
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.EndUpdate())
' If the refresh rate isn't already set, set it to the time taken to complete the Update PLUS the Seconds specified in the SETTINGS.INI File
Dim difference As TimeSpan = DateTime.Now.Subtract(StartTime)
If UpdateTimeInSeconds = -1 Then
UpdateTimer.Interval = (RefreshRate + difference.TotalSeconds) * 1000
End If
' Restart the Update Timer
UpdateTimer.Start()
End Sub
I was under the impression, that I can update the GUI (get the OLV selecteditems, etc.) from the WorkerProgressChanged and WorkerCompleted backgroundworker events but I get the darn cross-thread error.
I'm also having to INVOKE the BEGIN\END UPDATE as calling them directly produces error.
I have read that the olv.setobjects in ObjectListView 2.91 (the version I am using) should persist the selections but I haven't seen this at all.
Please! What am I missing? Its probably something daft or is there another way of doing this?
If you are not using a Forms.Timer (but Timers.Timer or Threading.Timer) for your UpdateTimer, anything called from the timer "tick" event will run on a different thread.
Thus, PopulateDevices would also be called from a non GUI thread and the BackgroundWorker will run on that thread as well.
I have a model simluation coded in Excel VBA. It is built inside of a class module named "ChemicalRelease". There is another Class module named "UniversalSolver" which works to optimize parameters of the ChemicalRelease.
While running different simulations, universalSolver will sometimes use a combination of parameters that goes outside of the modeling bounds of the application. It is difficult to determine the true modeling boundaries as it is based on multiple combinations of parameters.
An instance of UniversalSolver will create a set of input parameters and instantiate ChemicalRelease to run a model as specified. Inside of ChemicalRelease, the flow works within several methods such as "setden" which may call other methods to perform their calculation. For example, "setden" may call "tprop" to determine thermodynamic properties, and "tprop" may in turn call a function to iteratively solve for a value.
At any point within any of these methods, the model may determine that the combination of input parameters cannot be solved. The current configuration notifies me of the issue thru a msgbox and stops the program, bringing it into debug mode.
I would like to make use of an event handler that will set a value of an instance of a handler that will stop calculations within "ChemicalRelease", set the instance to "Nothing" and return control to "UniversalSolver", directly after the line where "ChemicalRelease" was instantiated and called for modeling.
serveral google searches, and none point to a way to return control to "UniversalSolver".
'event handler code: credit to Change in variable triggers an event
"ClassWithEvent" class
Public Event VariableChange(value As Integer)
Private p_int As Integer
Public Property Get value() As Integer
value = p_int
End Property
Public Property Let value(value As Integer)
If p_int <> value Then RaiseEvent VariableChange(value) 'Only raise on
actual change.
p_int = value
End Property
"ClassHandlesEvent" class
Private WithEvents SomeVar As ClassWithEvent
Private Sub SomeVar_VariableChange(value As Integer) 'This is the event
handler.
'line here to return control to "UniversalSolver" instance, out of
"ChemicalRelease" instance, regardless of how many methods have to be
returned out of within ChemicalRelease.
End Sub
Public Property Get EventVariable() As ClassWithEvent
Set EventVariable = SomeVar
End Property
Public Property Let EventVariable(value As ClassWithEvent)
Set SomeVar = value
End Property
"Globals" Module
'Globally set instances for ClassHandlesEvent and ClassWithEvent
Global VAR As ClassHandlesEvent
Global TST As ClassWithEvent
"UniversalSolver" class
Public Sub initialize()
Set VAR = New ClassHandlesEvent
Set TST = New ClassWithEvent
VAR.EventVariable = TST
End Sub
Public Sub solve()
Do 'iterate through potential input parameters
Set m_chemRelease = New ChemicalRelease
m_chemRelease.initialize 'initializes and launches modeling
Loop until satisfied
End Sub
"ChemicalRelease" class
Public Sub initialize(modelParamsSheet As Worksheet)
Set m_modelParamsSheet = modelParamsSheet
Call readModelInputsAndSetProperties(0)
End Sub
Private Sub readModelInputsAndSetProperties(inNum As Integer)
'set all properties and launch modeling
Call setjet(0)
End Sub
Private Sub setjet(inInt As Integer)
'lots of math.
call tprop(tpropsInputDict)
'lots more math.
End Sub
Private Sub tprop(inDict as Scripting.Dictionary)
'more math.
'check for convergence
If check > 0.00001 Then
'failed convergence
'trigger event to exit ChemicalRelease Instance and return control
to UniversalSolver instance
TST.value = 2
End If
'more math.
Call limit()
End Sub
Private Sub limit()
'more math.
'check for sign
If fa * fb > 1 Then
'failed convergence
'trigger event to exit ChemicalRelease Instance and return control
to UniversalSolver instance
TST.value = 2
End If
'more math.
End Sub
Expected results are to have an event which can be triggered at any location within the project that will return control to UniversalSolver as if I was stating "exit sub" from within ChemicalRelease.initialize. However, I cannot find a valid method for this.
Error handling in the calling function works for all called functions. However, the "resume" command is required to take VBA out of error-handling mode. Per the code below, flow is returned to normal mode at the "endoffor" label in the calling function.
errcatch:
Err.Clear
On Error GoTo errcatch
Resume endoffor '
I am trying to solve this good old problem in my own environment, adapted lots of different solutions, still no success.
I have a User Control, named EntryGrid, that has a DataGridView, it's headers and such things are set in the code. Then there is a form that has an EntryGrid dropped to it.
I know that excel columns must be prepared to be able to paste all cells into a row, for this I used this solution: copypaste, except the Copy part. This is how it looks like at my place:
Private Sub EntryGrid_KeyDown(sender As Object, e As KeyEventArgs) Handles EntryGrid4.KeyDown, EntryGrid8.KeyDown, EntryGrid16.KeyDown, EntryGrid32.KeyDown
e.Handled = True
Dim entryGrid As EntryGrid = sender
Dim dataGrid As DataGridView = entryGrid.DataGrid
If (e.Control And e.KeyCode = Keys.V) Then
MessageBox.Show("Success") 'for now
End If
End Sub
This is absolutely not working for me. I even set KeyPreview to True in the form, but nothing happens ever.
Then I tried this solution, mine with any result:
Private Sub EntryGrid_EditingControlShowing(sender As System.Object, e As System.Windows.Forms.DataGridViewEditingControlShowingEventArgs) Handles EntryGrid4.EditingControlShowing
AddHandler e.Control.KeyDown, AddressOf cell_KeyDown
End Sub
Private Sub cell_KeyDown(sender As Object, e As KeyEventArgs)
If e.KeyCode = Keys.V Then
MessageBox.Show("Success")
End If
End Sub
EntryGrid4 is the name of the usercontrol on the form, but it hasn't got any EditingControlShowing event, only DataGridView has, but I cannot use like this: EntryGrid4.DataGrid.EditingControlShowing
I created an event in EntryGrid (Public Event EditingControlShowing(sender As Object, e As DataGridViewEditingControlShowingEventArgs)), but anything's changed.
I am able to paste anything from clipboard to a cell, but it had been possible before I started the modifying.
Thanks for any idea!
ProcessCmdKey method of your UserControl is what you are looking for. Override it and check for Ctrl + V and do what you need. For example:
protected override bool ProcessCmdKey(ref Message msg, Keys keyData)
{
if (keyData == (Keys.Control | Keys.V))
{
if (dataGridView1.EditingControl != null)
dataGridView1.EditingControl.Text = Clipboard.GetText();
else if (dataGridView1.CurrentCell != null)
this.dataGridView1.CurrentCell.Value = Clipboard.GetText();
return true;
}
return base.ProcessCmdKey(ref msg, keyData);
}
I have a program that runs a scoretable front screen. I want to have a running ad loop of videos that pop up based on a timer. I created a separate form to play the video and am using a timer to open the form and play one video, then I am incrementing a global variable, closing the form, then waiting for the timer to reopen the form. When the timer tries to reopen the form, it is giving me a thread error. I am somewhat new to this level of coding and am confused about why this error is occuring and how to fix it. I read up on the topic and think I generally understand the problem, but can't seem to find the proper code to get it to work. Here is the code (global variable of VAds) I have used the invoke procedure to fix this problem with a picture box, but cant figure out the same thing for the video. Thanks in advance.
Private Sub PlayAdVideos(sender As Object, e As EventArgs) Handles VideoAds.Click
On Error Resume Next
If Application.OpenForms().OfType(Of frmAds).Any Then
frmVideoAds.Close()
Play_Ads.Text = "Start Video Advertisement Loop"
Exit Sub
Else
Play_Ads.Text = "Close Video Advertisement Loop"
Dim Sz As Integer
If ScreenNo.Text = "" Then
Sz = 1
Else
Sz = ScreenNo.Text
End If
Dim screen As Screen
screen = Screen.AllScreens(Sz)
frmVideoAds.StartPosition = FormStartPosition.Manual
frmVideoAds.Location = screen.Bounds.Location + New Point(0, 0)
frmVideoAds.WindowState = FormWindowState.Maximized
frmVideoAds.FormBorderStyle = FormBorderStyle.None
frmVideoAds.TopMost = True
frmVideoAds.BackColor = Color.Black
frmVideoAds.Show()
End If
For Each foundFile As String In My.Computer.FileSystem.GetFiles("C:\CCHS\VideoAds\")
VideoAdList.Items.Add(foundFile)
Next
If VideoAdList.Items.Count = 0 Then
Exit Sub
End If
Dim TMR2 As New System.Timers.Timer()
VideoAdNum = VideoAdList.Items.Count - 1
TMR2.Interval = 10000 'miliseconds
TMR2.Enabled = True
TMR2.Start()
AddHandler TMR2.Elapsed, AddressOf OnTimedEvent
End Sub
Public Sub OnTimedEvent(ByVal sender As Object, ByVal e As ElapsedEventArgs)
If frmVideoAds.InvokeRequired Then
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Invoke(Sub() frmVideoAds.Show())
Else
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Show()
End If
End Sub
System.Timers.Timer elapsed events will generally always be fired on a thread other than the UI thread.
Which means you'll have to call the frmVideoAds.Invoke every time you call frmVideoAds.Show() in that method.
Your else statement should just need to have the invoke added, which would make both execution paths the same so you could update the whole thing.
Public Sub OnTimedEvent(ByVal sender As Object, ByVal e As ElapsedEventArgs)
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Invoke(Sub() frmVideoAds.Show())
End Sub
This will generally work, but in some cases , ActiveX in particular, the System.Timers is required to be in a Single Threaded Apartment (STA). It defaults to a Multi threaded apartment (MTA). To force it into a STA mode simply add
TMR2.SynchronizingObject = Me
just before your TM2.Start().
I'm looking to implement a "Stack" Class in VBA for Excel. I want to use a Last In First Out structure. Does anyone came across this problem before ? Do you know external libraries handling structure such as Stack, Hastable, Vector... (apart the original Excel Collection etc...)
Thanks
Here is a very simple stack class.
Option Explicit
Dim pStack As Collection
Public Function Pop() As Variant
With pStack
If .Count > 0 Then
Pop = .Item(.Count)
.Remove .Count
End If
End With
End Function
Public Function Push(newItem As Variant) As Variant
With pStack
.Add newItem
Push = .Item(.Count)
End With
End Function
Public Sub init()
Set pStack = New Collection
End Sub
Test it
Option Explicit
Sub test()
Dim cs As New cStack
Dim i As Long
Set cs = New cStack
With cs
.init
For i = 1 To 10
Debug.Print CStr(.Push(i))
Next i
For i = 1 To 10
Debug.Print CStr(.Pop)
Next i
End With
End Sub
Bruce
Bruce McKinney provided code for a Stack, List, and Vector in this book (it was VB5(!), but that probably doesn't matter much):
http://www.amazon.com/Hardcore-Visual-Basic-Bruce-McKinney/dp/1572314222
(It's out of print, but used copies are cheap.)
The source code appears to be available here:
http://vb.mvps.org/hardweb/mckinney2a.htm#2
(Caveat - I've never used any of his code, but I know he's a highly regarded, long-time VB expert, and his book was included on MSDN for a long time.)
I'm sure there are also many different implementations for these things floating around the internet, but I don't know if any of them are widely used by anybody but their authors.
Of course, none of this stuff is that hard to write your own code for, given that VBA supports resizeable arrays (most of the way to a vector) and provides a built-in Collection class (most of the way to a list). Charles William's answer for a stack is about all the info you need. Just provide your own wrapper around either an array or a Collection, but the code inside can be relatively trivial.
For a hashtable, the MS Scripting Runtime includes a Dictionary class that basically is one. See:
Hash Table/Associative Array in VBA
I do not know of any external VBA libraries for these structures.
For my procedure-call stack I just use a global array and array pointer with Push and Pop methods.
You can use the class Stack in System.Collections, as you can use Queue and others. Just search for vb.net stack for documentation. I have not tried all methods (e.g. Getenumerator - I don't know how to use an iterator, if at all possible in VBA). Using a stack or a queue gives you some nice benefits, normally not so easy in VBA. You can use
anArray = myStack.ToArray
EVEN if the stack is empty (Returns an array of size 0 to -1).
Using a custom Collections Object, it works very fast due to its simplicity and can easily be rewritten (e.g. to only handle strongly typed varibles). You might want to make a check for empty stack. If you try to use Pop on an empty stack, VBA will not handle it gracefully, as all null-objects. I found it more reasonable to use:
If myStack.Count > 0 Then
from the function using the stack, instead of baking it into clsStack.Pop. If you bake it into the class, a call to Pop can return a value of chosen type - of course you can use this to handle empty values, but you get much more grief that way.
An example of use:
Private Sub TestStack()
Dim i as long
Dim myStack as clsStack
Set myStack = New clsStack
For i = 1 to 2
myStack.Push i
Next
For i = 1 to 3
If myStack.Count > 0 Then
Debug.Print myStack.Pop
Else
Debug.Print "Stack is empty"
End If
Next
Set myStack = Nothing
End Sub
Using a LIFO-stack can be extremely helpful!
Class clsStack
Dim pStack as Object
Private Sub Class_Initialize()
set pStack = CreateObject("System.Collections.Stack")
End Sub
Public Function Push(Value as Variant)
pStack.Push Value
End Function
Public Function Pop() As Variant
Pop = pStack.Pop
End Function
Public Function Count() as long
Count = pstack.Count
End Function
Public Function ToArray() As Variant()
ToArray = pStack.ToArray()
End Function
Public Function GetHashCode() As Integer
GetHashCode = pStack.GetHashCode
End Function
Public Function Clear()
pStack.Clear
End Function
Private Sub Class_terminate()
If (Not pStack Is Nothing) Then
pStack.Clear
End If
Set pStack = Nothing
End Sub