Everything I read points me to the need to run my "CollectSample" function in a backgroundworker1 but using all the samples I can't figure it out or compile. Because I am very new to vb, and not a strong programmer, I can't figure out how to invoke, or use background worker in the following code. A quick summary, I am calling realterm as a process and it opens and closes just fine, but locks out win form and because its in a loop of 16, I can't breakout if needed? Any help or guidance would be appreciated.
Private Sub Button35_Click(sender As Object, e As EventArgs) Handles Button35.Click
ProgressBar2.Visible = True
ProgressBar2.Value = 0
For i As Integer = 17 To 32
DirectCast(Me.Controls.Find("Button" & i, True)(0), Button).Visible = False
Next
For Bindex = 17 To 32
Dim Counter As Integer = 0
Dim Tone As Integer = TextBox1.Text
Dim Duration As Integer = TextBox2.Text
Duration = Duration * 2
For Counter = 1 To Duration
Counter = Counter + 1
NtBeep(Tone, 200) 'f,d
Next
CollectSample("SAMPLE" & Bindex - 16 & ".txt") 'subtracting the first 16
ProgressBar2.PerformStep()
CheckSample("SAMPLE" & Bindex - 16 & ".txt")
DirectCast(Me.Controls.Find("Label" & Bindex, True)(0), Label).Visible = True
DirectCast(Me.Controls.Find("Button" & Bindex, True)(0), Button).Visible = True
If SampleFlag = 1 Then 'error readiing from instument
DirectCast(Me.Controls.Find("Label" & Bindex, True)(0), Label).Text = "Er00"
DirectCast(Me.Controls.Find("Button" & Bindex, True)(0), Button).Text = "Er00"
End If
If SampleFlag = 2 Then 'sample count error
DirectCast(Me.Controls.Find("Label" & Bindex, True)(0), Label).Text = IncSamp
DirectCast(Me.Controls.Find("Button" & Bindex, True)(0), Button).Text = IncSamp
End If
If SampleFlag = 0 Then 'sample good
If SendMyAvg <> 0 Then
SendMyAvg = Math.Round(SendMyAvg, 2)
' MessageBox.Show("Button" & Bindex & " / " & SendMyAvg)
DirectCast(Me.Controls.Find("Label" & Bindex, True)(0), Label).Text = SendMyAvg
DirectCast(Me.Controls.Find("Button" & Bindex, True)(0), Button).Text = SendMyAvg
End If
End If
Next
End Sub
Private Sub CollectSample(ByVal Samplefile As String) 'call realterm, close realterm
NtBeep(500, 200) 'f,d
'http://www.dotnetperls.com/process-vbnet
Dim p As New ProcessStartInfo
p.FileName = "C:\Program Files (x86)\BEL\Realterm\realterm.exe"
p.Arguments = "C:\Program Files (x86)\BEL\Realterm\realterm.exe Baud=4800 Data=7E2 Port=" & USBPort & " timestamp=4 capfile=C:\IMAX_Ware_V2\LS100Cap\""" & targetName & """ capsecs=35 capture=1 Sendfile=""" & sourceName & """ Senddly=3000 Sendrep=10 CapQuit"
p.WindowStyle = ProcessWindowStyle.Hidden
Dim myProcess As Process = System.Diagnostics.Process.Start(p)
myProcess.WaitForExit()
myProcess.Close()
End Sub
Related
Public Function GetMetaDataFromPIC(ByVal _imgpath As String) As String
Dim fname As String
Dim RichTextBox1 As New RichTextBox
Dim myStreamReader As System.IO.StreamReader
Dim OneLine As String
Dim ffmpeg As Process
Dim Fi As FileInfo
Try
Application.DoEvents()
Fi = New FileInfo(_imgpath)
'fcreated_date = Fi.LastWriteTime.ToShortDateString
fname = _imgpath
ffmpeg = New Process
ffmpeg.StartInfo.WindowStyle = ProcessWindowStyle.Normal
ffmpeg.StartInfo.FileName = """" & Application.StartupPath & "\exiftool.exe"""
ffmpeg.StartInfo.UseShellExecute = False
ffmpeg.StartInfo.RedirectStandardError = True
ffmpeg.StartInfo.RedirectStandardOutput = True
ffmpeg.StartInfo.CreateNoWindow = True
'ffmpeg.StartInfo.Arguments = "-verbose & """ & _imgpath & """ "
ffmpeg.StartInfo.Arguments = " & """ & _imgpath & """ "
ffmpeg.Start()
RichTextBox1.Text = ""
myStreamReader = ffmpeg.StandardOutput
Dim i As Integer = 0
OneLine = myStreamReader.ReadLine()
Do
' Application.DoEvents()
i = i + 1
RichTextBox1.AppendText(OneLine + System.Environment.NewLine)
OneLine = myStreamReader.ReadLine()
If i > 200 Then Exit Do
Loop Until ffmpeg.HasExited And (OneLine Is Nothing)
If RichTextBox1.Text <> "" Then
GetMetaDataFromPIC = RichTextBox1.Text
Else
GetMetaDataFromPIC = ""
End If
myStreamReader.Close()
Catch ex As Exception
Write_ErrorLog(ex.Message & vbTab & "GetMetaDataFromPIC of " & _imgpath)
GetMetaDataFromPIC = ""
Finally
End Try
End Function
this is the code i am using to find metadata of image but everyday once in night i get this Error Creating Windows Handles error and it crash my application.
I'm currently writing a GUI for xmr-stak (www.xmrgui.com)
Having some trouble getting the output from the program and basically want to grab the last 30 lines from the output text file and append them to the RichTextBox if they don't already exist. Storing the text file in memory isn't a big issue because it will be deleted every 20 min or so...at least so I think. Maybe my function is taking up too much memory or time as it is.
My only requirement is that the Sub TimerOutput_tick can process each of the 30 last lines of text from the file to run a regex on each line and that the RichTextBox does not repeat old information.
Heres my code:
Private Function getlastlines(filename As String, numberOfLines As Integer) As Dictionary(Of Integer, String)
Try
Dim fs = File.Open(filename, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim everything As New Dictionary(Of Integer, String)
Dim n As Integer = 1
While reader.Peek > -1
Dim line = reader.ReadLine()
If everything.ContainsKey(n) Then
everything(n) = line
n += 1
Else
everything.Add(n, line)
n += 1
End If
End While
Dim results As New Dictionary(Of Integer, String)
Dim z As Integer = 1
If n - numberOfLines > 0 Then
For x As Integer = n - numberOfLines To n - 1
'MsgBox(everything.Count - numberOfLines)
If results.ContainsKey(z) Then
results(z) = everything(x)
z += 1
Else
results.Add(z, everything(x))
z += 1
End If
Next
End If
Return results
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Function
' GRABS XMR-STAK OUTPUT FROM ReadLastLinesFromFile AND RUNS A REGEX ON THE HASHRATE TO PROVIDE VALUES TO THE CHART
And here is the Sub that calls the previous function:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
'Try
Dim lateststring = getlastlines(xmroutput, 30)
Try
If lateststring IsNot rtlateststring Then
Dim kvp As KeyValuePair(Of Integer, String)
For Each kvp In lateststring
If lateststring.ContainsKey(kvp.Key) Then
Dim line = kvp.Value
RichTextBox1.AppendText(line & vbCrLf)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
nvidiavalues.add(0)
nvidiavalues.add(4)
nvidiavalues.add(2)
nvidiavalues.add(5)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
AMDValues.add(0)
AMDValues.add(4)
AMDValues.add(2)
AMDValues.add(5)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
CPUValues.add(0)
CPUValues.add(4)
CPUValues.add(2)
CPUValues.add(5)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
rtlateststring = lateststring
End If
Next
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
End If
Catch
End Try
End Sub
I've found a much easier solution, running the code within one function and then loading the entire text file into the richtextbox. From there its much easier to read the last ten lines individually:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
Try
'Dim lateststring = getlastlines(xmroutput, 30)
' START NEW TEST
Dim fs = File.Open(xmroutput, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim wholefile = reader.ReadToEnd
RichTextBox1.Text = wholefile
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
For x As Integer = 1 To 10
Dim line As String = RichTextBox1.Lines(RichTextBox1.Lines.Length - x)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
nvidiavalues.add(0)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
AMDValues.add(0)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
CPUValues.add(0)
Chartvalues.add(0)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
Next
Catch
End Try
' END NEW TEST
End Sub
I am trying to develop a simple bulk copy program that polls a given folder for files at specified intervals.
The code looks perfect. My output gives a great recursive list of files, but when I go to actually move them according to the list, every file I scanned is locked. I have tried garbage collecting, disposing, exiting subs at certain points, debugging at certain points...
Please take a look at my code. When MoveFile is called, everything is locked.
Imports System
Imports System.IO
Public Structure FileStructure
Dim Enumerator As Integer
Dim SPath As String
Dim DPath As String
Dim Name As String
Dim FileSize As Long
Dim IsFile As Short
Dim SourceFullName As String
Dim DestFullName As String
End Structure
Public Class StagingDriveCoordinator
Dim FilesScanned As FileStructure()
Dim ScanCount As Integer = -1
Private Sub ScanAll(ByVal sourcePath As String, ByVal destinationPath As String)
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(sourcePath)
' ---------------------- Create the appropriate directories --------------------------------
' Create source path
If Not System.IO.Directory.Exists(sourcePath) Then
System.IO.Directory.CreateDirectory(sourcePath)
End If
' If the destination folder doesn't exist then create it
If Not System.IO.Directory.Exists(destinationPath) Then
System.IO.Directory.CreateDirectory(destinationPath)
End If
' ------------------------------------------------------------------------------------------
Dim AddSize As Integer = 0
'Figure out how much to resize the array this iteration of ScanAll
If FilesScanned IsNot Nothing Then
AddSize = FilesScanned.Count + sourceDirectoryInfo.GetFileSystemInfos.Length
Else
AddSize = sourceDirectoryInfo.GetFileSystemInfos.Length
End If
'Resize the array
Array.Resize(FilesScanned, AddSize)
For Each FileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
ScanCount += 1
FilesScanned(ScanCount).Enumerator = ScanCount
FilesScanned(ScanCount).SPath = sourcePath.ToString
FilesScanned(ScanCount).DPath = destinationPath.ToString
FilesScanned(ScanCount).Name = FileSystemInfo.Name.ToString
If TypeOf FileSystemInfo Is System.IO.FileInfo Then
FilesScanned(ScanCount).FileSize = DirectCast(FileSystemInfo, FileInfo).Length
FilesScanned(ScanCount).IsFile = 1
Else
FilesScanned(ScanCount).FileSize = 9223372036854775807
FilesScanned(ScanCount).IsFile = 0
End If
FilesScanned(ScanCount).SourceFullName = System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName = System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
txtOutput.Text += FilesScanned(ScanCount).Enumerator & vbTab & FilesScanned(ScanCount).SourceFullName & vbNewLine
If FilesScanned(ScanCount).IsFile = 0 Then
'Debug
txtOutput.Text += vbNewLine & "Recursively scanning subfolder " + FilesScanned(ScanCount).Name & "..." + vbNewLine + vbNewLine
'Recursively call the main scanner.
ScanAll(FilesScanned(ScanCount).SourceFullName, FilesScanned(ScanCount).DestFullName)
End If
Next
End Sub
Private Sub MoveFile(ByVal Source, ByVal Destination, ByVal filesize)
Try
File.Copy(Source, Destination, True)
txtOutput.Text += "Moving file... Source: " & Source & ". Filesize: " & filesize.ToString & vbNewLine
txtOutput.Text += "Destination: " & Destination & vbNewLine & vbNewLine
File.Delete(Source)
Catch ex As Exception
txtOutput.Text += "File " & Source & " is locked." & vbNewLine
End Try
End Sub
Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
Select Case cmbPollingFrequency.SelectedItem
Case "5 Seconds"
Timer1.Interval = 5000
Case "30 Seconds"
Timer1.Interval = 30000
Case "1 Minute"
Timer1.Interval = 60000
Case "5 Minutes"
Timer1.Interval = 300000
Case "15 Minutes"
Timer1.Interval = 900000
Case "30 Minutes"
Timer1.Interval = 1800000
Case "1 Hour"
Timer1.Interval = 3600000
Case Else
MsgBox("You must select an interval.")
End Select
Timer1.Start()
End Sub
Private Sub TimerTick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Stop()
txtOutput.Text += DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & vbNewLine
txtOutput.Text += "Scanning Filesystem..." + vbNewLine + vbNewLine
'Scan the file system.
ScanAll(cmbStaging.Text, cmbBackup.Text)
txtOutput.Text += vbNewLine
txtOutput.Text += DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & vbNewLine
txtOutput.Text += " ------------- Scan cycle completed. --------------- " & vbNewLine & vbNewLine
txtOutput.Text += "Sorting by filesize..." & vbNewLine & vbNewLine
' Sort the file list by size.
FilesScanned = FilesScanned.OrderBy(Function(x) x.FileSize).ToArray
txtOutput.Text += "Done." & vbNewLine & vbNewLine
txtOutput.Text += "Moving smallest files first..." & vbNewLine & vbNewLine
For Each FileElement In FilesScanned
If FileElement.IsFile > 0 Then
'file.FileSize only needed to pass size to text output
MoveFile(FileElement.SourceFullName, FileElement.DestFullName, FileElement.FileSize)
End If
Next
FilesScanned = Nothing
ScanCount = -1
Timer1.Start()
End Sub
Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
Timer1.Stop()
End Sub
End Class
I found the problem. The IO system was NOT locking the file. I was trying to copy it to the SAME directory...
FilesScanned(ScanCount).SourceFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
This should have been:
FilesScanned(ScanCount).SourceFullName =
System.IO.Path.Combine(sourcePath, FileSystemInfo.Name).ToString
FilesScanned(ScanCount).DestFullName =
System.IO.Path.Combine(destinationPath, FileSystemInfo.Name).ToString
Once I changed it, everything worked perfectly.
How can I change a specific control, with variable .text
If Me.Controls.OfType(Of Button) = ("Button" & Bindex) Then
button.Text = PostMyresult
End If
So , no Joy, attached is the code block. Hope its not too polluted:
` Private Sub Button34_Click(sender As Object, e As EventArgs) Handles Button34.Click
Dim DaButton As String
For Bindex As Integer = 1 To 2
DaButton = ("Button" & Bindex & ".Text = SAMPLE" & Bindex)
MessageBox.Show(DaButton)
' Me.Button1.Text = "SAMPLE1"
CollectSample(DaButton & ".Text" & ".txt") 'works grabs sample from spectrum anlzr
CheckSample(DaButton & ".Text" & ".txt") 'works error check
' MessageBox.Show(SampleFlag)
If SampleFlag <> 0 Then
SendMyAvg = Math.Round(SendMyAvg, 2)
If SendMyAvg < 1 Then
MessageBox.Show("Average Sample Is < 1 ")
' Me.Button1.Text = "SAMPLE1"
For Each myCtrl As Control In Me.Controls
If (TypeOf myCtrl Is Button) Then
If myCtrl.Name = "Button" & Bindex Then
myCtrl.Text = DaButton
End If
End If
Next
Exit Sub
End If
' MessageBox.Show("Button" & Bindex & " / " & SendMyAvg)
For Each myCtrl As Control In Me.Controls
If (TypeOf myCtrl Is Label) & myCtrl.Name = "Label" & Bindex Then
myCtrl.Text = SendMyAvg
MessageBox.Show("Button" & Bindex & " / " & SendMyAvg)
End If
Next
' Button1.Text = SendMyAvg
' MsgBox("Avg Is " & SendMyAvg)
End If
Next
End Sub`
Well if you have Linq, you can do this:
Dim btn = Me.Controls.OfType(Of Button).Where(Function(x) x.Name = "Button1" & Bindex)
If btn.Count > 0 Then
btn(0).Text = "New Text"
End If
Try this:
For Each myBtn as Button In Me.Controls.OfType(Of Button)
If myBtn.Name = "Button" & Bindex Then
myBtn.Text = PostMyResult
End If
Next
solution:
DirectCast(Me.Controls.Find("Label" & Bindex, True)(0), Label).Text = SendMyAvg
Try this:
Dim c As Control
Dim myButton As String
For i = 1 To 2
myButton = "Button" & i
c = Controls.Find(myButton, True).FirstOrDefault()
c.Text = "New Text"
Next i
I have the following sub
Public Sub Transfer()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Searching_Date As String
Dim Name As String
Dim Presente As Boolean
Dim Foto_Presente As Boolean
For i = 0 To CDIi - 1
Searching_Date = Image_Date(Camera_Day_Images(i))
Name = Replace(Camera_Day_Images(i), Camera & Path_in_Camera & "\", "")
Presente = False
j = 0
While (Not Presente And j <= PCi)
If (Path & "\" & Right_Date(Searching_Date)) = PC_Directory(j) Then
Presente = True
Else
Presente = False
End If
j = j + 1
End While
If Presente = True Then
Foto_Presente = False
k = 0
List_PC_Day_Images(Path & "\" & Right_Date(Searching_Date))
While (Not Foto_Presente And k <= PDIi)
If (Path & "\" & Right_Date(Searching_Date) & "\" & Name) = PC_Day_Images(k) Then
Foto_Presente = True
Else
Foto_Presente = False
End If
k = k + 1
End While
If Foto_Presente = True Then
Else
My.Computer.FileSystem.CopyFile(Camera & Path_in_Camera & "\" & Name, Path & "\" & Right_Date(Searching_Date) & "\" & Name)
PC_Day_Images(PDIi) = Path & "\" & Right_Date(Searching_Date) & "\" & Name
PDIi = PDIi + 1
End If
Else
My.Computer.FileSystem.CreateDirectory(Path & "\" & Right_Date(Searching_Date))
My.Computer.FileSystem.CopyFile(Camera & Path_in_Camera & "\" & Name, Path & "\" & Right_Date(Searching_Date) & "\" & Name)
End If
Next
Principale.LFine.Text = "Tutte le tue foto sono state trasferite con successo"
Principale.Button1.Enabled = False
End Sub
It copies any photos from my device to my computer. So if I have a lot of photos It can take several time and I want to notify this. In fact I change the text in the label, than I call the Sub and finally rechange the label.
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
LFine.Text = "attendere prego..."
Transfer()
LFine.Text = "Operazione completata con successo"
End Sub
But the results are that Transfer () starts and just after he finished changing the label.
Why??? How can I fix this problem??
Thank you.
After LFine.Text = "attendere prego..." add this line:
LFine.Update()
See https://msdn.microsoft.com/en-us/library/vstudio/system.windows.forms.control.update(v=vs.100).aspx
Wrap the call to tranfers() in an if statement
Change your Sub to a Function,
Public Function Transfer() As Boolean
...
then
If tranfers() = true then
LFine.Text = "Operazione completata con successo"
End if
That is because your process is a blocking process. The label is "updated" but the form is redrawn only after the whole process ends. Others have suggested to use Application.DoEvents() or LFine.Update, but the best way to do what you want is to make your process parallel.
You could use a BackgroundWorker for this:
Imports System.ComponentModel
Dim bgw As New BackgroundWorker
In the Load event of your form...
AddHandler bgw.DoWork, AddressOf bgw_DoWork
AddHandler bgw.RunWorkerCompleted, AddressOf bgw_RunWorkerCompleted
And then set your code like this...
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
LFine.Text = "attendere prego..."
bgw.RunWorkerAsync()
End Sub
Private Sub bgw_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles bgw.DoWork
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Searching_Date As String
Dim Name As String
Dim Presente As Boolean
Dim Foto_Presente As Boolean
For i = 0 To CDIi - 1
Searching_Date = Image_Date(Camera_Day_Images(i))
Name = Replace(Camera_Day_Images(i), Camera & Path_in_Camera & "\", "")
Presente = False
j = 0
While (Not Presente And j <= PCi)
If (Path & "\" & Right_Date(Searching_Date)) = PC_Directory(j) Then
Presente = True
Else
Presente = False
End If
j = j + 1
End While
If Presente = True Then
Foto_Presente = False
k = 0
List_PC_Day_Images(Path & "\" & Right_Date(Searching_Date))
While (Not Foto_Presente And k <= PDIi)
If (Path & "\" & Right_Date(Searching_Date) & "\" & Name) = PC_Day_Images(k) Then
Foto_Presente = True
Else
Foto_Presente = False
End If
k = k + 1
End While
If Foto_Presente = True Then
Else
My.Computer.FileSystem.CopyFile(Camera & Path_in_Camera & "\" & Name, Path & "\" & Right_Date(Searching_Date) & "\" & Name)
PC_Day_Images(PDIi) = Path & "\" & Right_Date(Searching_Date) & "\" & Name
PDIi = PDIi + 1
End If
Else
My.Computer.FileSystem.CreateDirectory(Path & "\" & Right_Date(Searching_Date))
My.Computer.FileSystem.CopyFile(Camera & Path_in_Camera & "\" & Name, Path & "\" & Right_Date(Searching_Date) & "\" & Name)
End If
Next
End Sub
Private Sub bgw_RunWorkerCompleted(ByVal sender As System.Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bgw.RunWorkerCompleted
Principale.LFine.Text = "Tutte le tue foto sono state trasferite con successo"
Principale.Button1.Enabled = False
End Sub
Just make sure you don't access any control of your form inside bgw_DoWork method.