I want to use progress bars for my project throughout, since it is very much necessary, for the main part of this game I am creating, however, to get a GOOD grade at A Level, you need to be able to show variation and to not have a large amount of data replication, is there any, remotely easy understandable way to allow for a button when pressed to allow for the progress bar to be completed for me in a 5 second time period. Please let me know. If you need any code It may be rather extensive a long, because I went a really unorthodox way about this originally. But just don't really want to have about 15-20 timers in the end product.
Private Sub ButtonClick2_Click(sender As Object, e As EventArgs) Handles ButtonClick2.Click
money = money + (4 * LevelMultiplier2)
label_avail_money.Text = Math.Round(money, 2).ToString("N2")
Public Class Form1
Dim money As Decimal = 0
Dim LevelMultiplier2 As Decimal = 1
Basically this is what is for this button, all I need for is for 1. For the Calculation to be ran 5 seconds prior to when the button is pressed and also to have a progress bar running simultaneously with the button press too. Hope this helps, also putting this into some form of code now may help me more to resolve this issue :)
You should use Microsoft's Reactive Framework (aka Rx) - NuGet System.Reactive.Windows.Forms and add Imports System.Reactive.Linq - then you can do this:
Private Sub ButtonClick2_Click(sender As Object, e As EventArgs) Handles ButtonClick2.Click
ButtonClick2.Enabled = False
Observable _
.Interval(TimeSpan.FromSeconds(5.0 / 100.0)) _
.Take(100) _
.ObserveOn(Me) _
.Subscribe(
Sub(x) ProgressBar1.Value = x + 1,
Sub()
money = money + (4 * LevelMultiplier2)
label_avail_money.Text = Math.Round(money, 2).ToString("N2")
ButtonClick2.Enabled = True
End Sub)
End Sub
That code nicely animates the progress bar and then fills in the label_avail_money.Text value.
Related
Its a label printing app. Desire to show progress via a counter displaying in a Label. ie. would like it to
look like this... 1000 increments to 1001 increments to 1002, 1003 etc. Pretty simple pgm so obviously processing from start to finish is instantaneous. Thus end number pops up right away rather than flashing a sequence of sorts. Don't need number to be readable but just simulating the process. Since it is a printing program, there is time for this display. At the end of processing the final number should be on the screen. Thought maybe I could use a timer to tick off before updating label. My coding is obviously not correct. Here it is. Any suggestions are appreciated. I am a 79 YO tinkerer programmer (worked back in the COBOL days) so be kind LOL.
Private Sub Button2_Click_1(sender As Object, e As EventArgs) Handles Button2.Click
' Print button
Dim toPrint As Integer = Me.NumericUpDown2.Value
Dim RetVal As Object
Dim TopPos As String = "375,200"
Dim InfoPos As String = "360,260"
startNo = TextBox2.Text
For index As Integer = 1 To toPrint
RetVal = RDP.PrintRawData("^XA^LL450^PQ" & arrCust(4) & "^CFB,30^FO" & TopPos & "^FD" & arrCust(5) & StartNo & "^FS^FO" & InfoPos & "^FD" & arrCust(2) & "^FS^XZ")
Timer1.Interval = 1000
Timer1.Start()
startNo += 1
Next
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Label4.Text = startNo
End Sub
The problem is the loop never yields control back to the underlying windows event message pump, and so there's never a chance to process any paint messages to redraw the label until after everything is finished.
To fix this we first need to resolve two conflicting statements:
from start to finish is instantaneous
and
Since it is a printing program, there is time for this display.
Only one of those two statements can be true. They are mutually exclusive.
If the first statement is true, I'd change the timer to tick more often (every 200 milliseconds or so; faster is just wasteful) and put up with an ugly Application.DoEvents call in the loop so the label can have a chance to repaint. (Also: start the timer once, before entering the loop, and not on each iteration).
If the latter statement is true, I'll echo the usual warnings about avoiding Application.DoEvents (there are a lot of "gotchas" with this method). Instead, I'd do it the right way, and use a BackgroundWorker component.
I'm running the following loop successfully when the number of items is low. However, when run against a larger list on the ListView, it seems to be taking way too long. I tested it with a list of 8,700 files and it took about two hours to complete. Is there something I can do to speed this up? I guess that removing the check for the Cancel button would help but I would like to keep that there for usability. As I've mentioned in earlier posts, I'm pretty new to Visual Basic so please provide lots of explanation with your suggestions. Thanks. Here's the code:
For i As Integer = 0 To m_CountTo
' Has the background worker be told to stop?
If BackgroundWorker1.CancellationPending Then
' Set Cancel to True
e.Cancel = True
Exit For
End If
'Select the row from the LVFiles ListView, then move the first column (0) into strSourceFilePath and the last
' column (3) into strDestFilePath. Execute the CopyFile method to copy the file.
LVFiles.Items(i).Selected = True
strSourceFilePath = LVFiles.SelectedItems(i).SubItems(0).Text
strDestFilePath = LVFiles.SelectedItems(i).SubItems(3).Text
My.Computer.FileSystem.CopyFile(strSourceFilePath, strDestFilePath, overwrite:=False)
' Report The progress of the Background Worker.
BackgroundWorker1.ReportProgress(CInt((i / m_CountTo) * 100))
' Me.LabelStatus.Text = FormatPercent((i + 1) / (intLVIndex + 1), 2) ' Show Percentage in Label
SetLabelText_ThreadSafe(Me.LabelStatus, FormatPercent(i / m_CountTo, 2))
Next
The Backgroundworker encapsulates a new thread. You cannot directly access controls that are created in another thread. If you do you will get an InvalidOperationException because of a cross-thread operation. The Backgroundworker however offers some functionality to share data (or access to controls) between threads. You should use them.
Private Sub StartBGW_Click(sender As Object, e As EventArgs) Handles StartBGW.Click
Dim dict As New Dictionary(Of String, String)
For i As Integer = 0 To m_CountTo
dict.Add(Me.LVFiles.Items(i).SubItems(0).Text,
Me.LVFiles.Items(i).SubItems(3).Text)
Next
Me.BackgroundWorker1.RunWorkerAsync(dict)
End Sub
First we prepare a dictionary that contains the source as Key and the target as Value. This object is given to the BackgroundWorker as a parameter.
Now comes the essential part:
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim counter As Integer = -1
Dim dict = DirectCast(e.Argument, Dictionary(Of String, String))
For Each kvp In dict
counter += 1
' Has the background worker be told to stop?
If Me.BackgroundWorker1.CancellationPending Then
' Set Cancel to True
e.Cancel = True
Exit For
End If
'Select the row from the LVFiles ListView, then move the first column (0) into strSourceFilePath and the last
' column (3) into strDestFilePath. Execute the CopyFile method to copy the file.
My.Computer.FileSystem.CopyFile(kvp.Key, kvp.Value, overwrite:=False)
' Report The progress of the Background Worker.
Me.BackgroundWorker1.ReportProgress(CInt((counter / m_CountTo) * 100), counter)
Next
End Sub
We don't access the ListView anymore. Instead we use the dictionary that is given to us as a parameter through e.Argument. Theres also a slight difference in the BackgroundWorker1.ReportsProgress line. There's a second parameter I have used to pass the current index to the ProgressChanged event which can be obtained via e.UserState.
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Me.LVFiles.Items(Convert.ToInt32(e.UserState)).Selected = True
Me.LabelStatus.Text = e.ProgressPercentage.ToString
End Sub
This event is designed to be raised with a SynchronizationContext of the calling thread, in this case the UI thread. Here we can safely access any control and update them. The index is passed as e.UserState, so we can access the relevant item and set their Selected property to true.
The biggest improvement comes from the change of Me.LVFiles.SelectedItems(i).SubItems(0).Text to Me.LVFiles.Items(i).SubItems(0).Text. I'm not a professional, but it seems that SelectedItems isn't a real list. Instead it iterates through every item using the SendMessage API until the desired index is reached. This is why it takes longer the higher your index is. Everytime it starts with the first item and iterates through them. Lot of operations.
The second improvement is the separation of code that access UI controls. It's all done in one method now. More clear and readable.
Update: #Enigmativity mentioned that SelectedListViewItemCollection implements IList and therefore is a real list. Even though it has no underlying list containing all selected items like you have in ListViewItemCollection. My point was to say, that accessing a single element is more complicated.
I have a program that allows a user to search for a customer by name. The way I have done this so far (code below) is have the user start typing the customer name in a TextBox (tbCust), the code fires on the TextChanged event and repopulates the ListBox based on what the user has typed. I think the idea here is obvious and commonly used.
This works without minimal lag on my computer but on some other users computers which are more base level machines, there is anywhere from 100ms to 300ms delay between updates which makes for a pretty crappy user experience.
Correct me if i'm wrong here but I feel like this functionality should be easily attainable without any perceived lag for just about any computer out there.
I assume there is a more correct/efficient way of doing this that I'm just not smart enough to come up with on my own (enter, all of you!)
Please shed some light on maybe a more 'appropriate' way of doing this that results in much better performance. I assume my problem lies with querying the database each time the routine runs (every time the user types a letter) but I'm not sure how else to do it while still working with live data.
Many Many Thanks in Advance!
Video of acceptable performance on my computer: Youtube Video #1
Video of unacceptable performance on user computer: YouTube Video #2
User Computer Specs:
Private Sub tbCust_TextChanged(sender As Object, e As EventArgs) Handles tbCust.TextChanged
'This populates the Customer Selection list box with customers whose names start with the
'string of letters in the customer name text box.
If tbCust.TextLength > 0 Then
lbCustSelect.Visible = True
Dim SQL As String
SQL = "SELECT C_CUSTOMER as ID, C_SHIPNAME as Name FROM CUSTOMER WHERE LEFT(C_SHIPNAME," & tbCust.TextLength & ") ='" & tbCust.Text & "'"
'Query Database
AeroDBcon.RunQuery(SQL)
'Fill DataTable with Query results
dtCustomers = AeroDBcon.DBds.Tables(0)
'Tie DataTable to ListBox
lbCustSelect.DataSource = dtCustomers
lbCustSelect.DisplayMember = "Name"
lbCustSelect.ValueMember = "ID"
'If there are no results, hide the ListBox
If dtCustomers.Rows.Count = 0 Then
lbCustSelect.Visible = False
End If
Else
'if there is no text in the customer name text box, hide the listbox
lbCustSelect.Visible = False
End If
End Sub
Filtering in SQL is usually quicker than filtering on client side. But since table CUSTOMER is probably not that large, and there seems to be an overhead issue with querying the database, let's query it all at once, and filter on the client side.
I like strong-typing. Even though you don't use an ORM, we can still create a class to hold your results:
Private Class Customer
Public Property ID As String
Public Property Name As String
End Class
And if we hold a collection of all customers,
Private customers As IEnumerable(Of Customer)
it's simply filtered like this
Dim filteredCustomers = customers.Where(Function(c) c.Name.StartsWith(filterString)).ToList()
Also, I wouldn't run the query on keypress. Nor would I run it on the UI thread (UI event handlers run on the UI, and that will cause your UI to freeze while the query runs). Run the query after a set amount of time since the last keypress, and run it off the UI. A System.Threading.Timer is perfect for this.
Private ReadOnly queryTimer As New System.Threading.Timer(AddressOf executeQuery, Nothing, -1, -1)
Private ReadOnly keyPressDelay As Integer = 100
Private customers As IEnumerable(Of Customer)
Private filterString As String = ""
Private Sub tbCust_TextChanged(sender As Object, e As EventArgs) Handles tbCust.TextChanged
filterString = tbCust.Text
lbCustSelect.Visible = filterString.Length > 0
If filterString.Length > 0 Then queryTimer.Change(keyPressDelay, -1)
End Sub
Private Sub executeQuery(state As Object)
' this could alternately be run in Form_Load
If customers Is Nothing Then
Dim sql = "SELECT C_CUSTOMER as ID, C_SHIPNAME as Name FROM CUSTOMER"
AeroDBCon.RunQuery(sql)
customers =
AeroDBCon.DBds.Tables(0).
AsEnumerable().Select(Function(dr) New Customer With {.ID = dr("ID").ToString(), .Name = dr("Name").ToString()})
End If
Dim filteredCustomers = customers.Where(Function(c) c.Name.StartsWith(filterString)).ToList()
' Dim filteredCustomers = customers.Where(Function(c) c.Name.Contains(filterString)).ToList()
' update the control on the UI thread
lbCustSelect.Invoke(
Sub()
lbCustSelect.DataSource = Nothing
lbCustSelect.DisplayMember = "Name"
lbCustSelect.ValueMember = "ID"
lbCustSelect.DataSource = filteredCustomers
End Sub)
End Sub
You should also dispose the timer when the form disposes. Modify your Dispose method to this
Protected Overrides Sub Dispose(disposing As Boolean)
Try
If disposing Then
components?.Dispose()
queryTimer?.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
I am trying to create a reminder system for my break schedule (because for some reason the tech company I work for does not have one in our scheduling system /facepalm)
I can make it work IF the time I write in the textbox for my break matches the system time. What I would like it to do is change it so it pops up once, 5 minutes before and then again when it matches the system time. Here is what i have so far for the on time reminder:
Sub Timer1Tick(sender As Object, e As EventArgs)
DaClock.Text = Format(Now, "h:mm")
For the sake of simplicity ^
If Coffee.Text = "DaClock.Text" And reminder.Checked = True Then
Coffee.Text = (Coffee.Text + " Over")
Coffee.Enabled = False
MsgBox("Break Time", MsgBoxStyle.Information, "break")
Else If Coffee.Text = DaClock.Text Then
Coffee.Text = (Coffee.Text + " Over")
Coffee.Enabled = False
End If
End Sub
I find that I am not able to figure out how to get the reminder to pop up 5 minutes before.
edit Oh it may not be relevant but DaClock is an invisible Label
Update
I was able to set up a secont label and a string with 5 minutes added so the event will trigger 5 minutes early but now i am having formatting issues:
Dim MyTime As String
MyTime = TimeOfDay.AddMinutes(5)
D5Clock.Text = Format(MyTime, "h:mm")
But all it shows in the Label is h:mm. If i choose not to format it and shows normally, (eg: 6:30:54 PM) but the formatting is important to make sure my break entries trigger as we are only using the h:mm (eg 6:30) in the fields.
While I can respect what you're doing, and especially that you progressed and just straight out beaten the shit out of your own challenge, I would like to suggest an alternative (explanations follows):
Public NotInheritable Class Reminder
Private Shared _instance As Reminder
Private Sub New()
'hehehe Private
End Sub
Public Shared Function GetInstance() As Reminder
If _instance Is Nothing Then _instance = New Reminder
Return _instance
End Function
Private Async Sub RemindMe(ByVal time As DateTime)
Dim waiting As Boolean = True
While (waiting)
Await Task.Delay(60000) 'This means "Check once every minute"
If time > Now Then
MessageBox.Show("Wake up, it's " & Now.ToShortTimeString & " !!")
waiting = False
End If
End While
End Sub
Public Sub Dispose()
Me.Dispose()
End Sub
End Class
So... what exactly is this unholy thing? It's a Singleton. It's a class which has only one instance, at all time - that's why the Sub New() is private: I don't want people to be able to instantiate this class! Except for you. You can get ONE, only one instance, by using the public function GetInstance() (if you ask for more than one instance, you'll always get the first one, so ask away if you feel like it).
Then you can ask it to remind you to do stuff by giving it a time when to awaken. It keeps track of your reminders on different threads, so don't worry about these hogging all your main thread's cpu. This is just a skeleton code snippet, though, and I suggest you alter it with custom messages and the like.
Don't forget to Dispose() of it if you want to keep your memory happy. It'll die eventually anyway when you dispose of it's parent object, but it's a healthy habit nonetheless.
It may or may not be something which will help you, and don't mind me if it's not something you want to deal with, but I felt like you might like it. Have fun!
Figured it out by running two clocks simultaneously and calling each one so it will happen 5 minutes early and then again on time.
D5Clock.Text = Format(TimeOfDay.AddMinutes(5), "h:mm")
DaClock.Text = Format(TimeOfDay, "h:mm")
whew
I'm trying to make a few images do the nice slidey thingy that I've seen lots of Microsoft applications use. The one where the movement starts slow speeds up half way there and then comes to a nice slow stop in it's new location. I've got all the calculations figured out, getting and setting the picture box locations, Confirmation using console.writeline that the image locations are correct, and even a test run that works in a simplified format.
But in the full blown version It's not repainting the image. In fact, it looks like nothing has happened at all while the script is running. I've tried Me.Refresh(), Invalidate(), Timer.Enabled = True/False, and Me.Update(). None of which have worked. The last step is the most frustrating: I'm calling my SetPanelLocation() method at the end to ensure that the panel ends up in the final location regardless of if the movement worked. Nothing happens on this call either, even though immediately after this routine fails I can call the same method from another user event and it starts working again like nothing was wrong.
I'm creating my own PictureBox class called clsFeedImageBox which inherits PictureBox that includes this functionality (along with other features). Each image is only 300x225 pixels so they're not massive images that take a lot of time to redraw. Each instance of this class is in a common Forms.SplitterPanel. I use a lot of comments out of habit so i left them in here, maybe they'll add some light.
Public Class clsFeedImgBox
Inherits PictureBox
Private iRank As Integer 'rank in whatever feed this file gets put in
Private iRankTarget As Integer 'rank to move to when rank feed event starts
Private iTopStart As Integer 'starting top location before feed event
Private iTopTarget As Integer 'final Top location after feed event
Private WithEvents tMyTimer As New System.Timers.Timer
Private WithEvents oParent As FeedBase 'splitter panel, all location info comes from the parent
Public Sub New(ByRef sender As FeedBase, ByVal rank as Integer)
'set objects
oParent = sender
'set .Image property to pre-made thumbnail
Image.FromFile(ThumbPath) 'ThumbPath is a property which is set by this point (some code has been removed)
'setup initial position
setPanelLocation(rank)
'set autosize
Me.SizeMode = PictureBoxSizeMode.StretchImage
'set Image Scroll timer interval to 20 fps (1000 / 20 = 50)
tMyTimer.Interval = 50
End Sub
Public Sub scroll(ByVal newRank As Integer)
'setPanelLocation(newRank) <== this works, timed movements don't
iRankTarget = newRank
iTopStart = Me.Top
iTopTarget = oParent.ImgTop(newRank) 'gets an integer for the new Top location
tMyTimer.Start()
End Sub
Private Sub myScrollStep() Handles tMyTimer.Elapsed
'tMyTimer.Enabled = False 'this idea with the enabled = True at the end didn't work
iTickCount += 1
Dim iScrollPerc As Integer 'scroll % between Start and End * 100
iScrollPerc = oParent.ScrollStep(iTickCount, Rank) 'this part works
Console.WriteLine(strThumbName & " scrollPerc: " & iScrollPerc.ToString)
If iScrollPerc >= 100 Then
'scroll event complete
Console.WriteLine(strThumbName & " SetFinalLocation")
Me.setPanelLocation(iRankTarget) '<== This line doesn't work here, but works when called by other means
'stop Feed updates
tMyTimer.Stop()
'reset iTickCount for next movement
iTickCount = 0
Else
'scrolling still going
Dim newTop As Integer
newTop = Math.Round(iTopTarget - (((100 - iScrollPerc) * (iTopTarget - iTopStart)) / 100)) 'this part works
'Console.WriteLine(strThumbName & " TopTarget: " & newTop)
Me.Top = newTop 'Nothing happens here
End If
'Me.Left = oParent.ImgLeft
'Me.Width = oParent.ImgWidth
'Me.Height = oParent.ImgHeight 'that didn't work
'Me.Refresh() 'this didn't work
'Invalidate() 'this didn't do much good either
'Me.Update() 'Aaaaand no cigar, time for StackOverflow
'tMyTimer.Enabled = True
End Sub
Public Sub setPanelLocation(ByVal rank As Integer)
iRank = rank
Me.MyRePaint()
End Sub
Public Sub MyRePaint()
'repaint image box with everything in it's current rank
Me.Left = oParent.ImgLeft
Me.Top = oParent.ImgTop(iRank)
Me.Width = oParent.ImgWidth
Me.Height = oParent.ImgHeight
End Sub
End Class
What gives? There must be some inner workings of VB.NET that will help me figure this out. I'm using VS 2012 and Win8
You could make a WPF application and use a Slider control instead of "manually" making a slider with planes, picture boxes, etc, etc.