I'm having a problem with a click-event that deletes a series of controls. In stepping though the click event, everything works perfectly but other text box controls on the page are being blanked out (not deleted, just losing their text content). I've stepped through the code and found that everything is find going into the "End Sub" statement of the click event but the blanking out happens when the End Sub is executed. I'm attaching the click event but there's not much to see. Any ideas what's happening?
Private Sub btnDelete_Click(sender As Object, e As EventArgs) Handles btnDelete.Click
CommonDelete(tbline.Text)
End Sub
Public Sub CommonDelete(LineNum As Integer)
Dim i As Integer = 0
Dim j As Integer = 0
Dim lineFound As Boolean = False
Dim LineInt As Integer = 0
Dim VLength As String = " "
Dim VLengthInt As Integer = 0
topLine = 0
bottomLine = 0
VLength = arrTextVals.GetLength(1)
VLengthInt = CInt(VLength)
Try
LineInt = CInt(LineNum)
Catch ex As Exception
MessageBox.Show("The line you selected is invalid", "Drop Zone Error DL1:",
MessageBoxButtons.OK,
MessageBoxIcon.Exclamation,
MessageBoxDefaultButton.Button1)
Exit Sub
End Try
For i = 1 To VLengthInt - 1
If arrTextVals(1, i) = LineNum Then
lineFound = True
Exit For
End If
Next
If lineFound <> True Then
MessageBox.Show("The line you selected is invalid", "Drop Zone Error DL2:",
MessageBoxButtons.OK,
MessageBoxIcon.Exclamation,
MessageBoxDefaultButton.Button1)
Exit Sub
End If
For j = i To VLengthInt - 2
topLine = j
bottomLine = j + 1
SwitchRows()
Next
RemoveControl(arrTextVals(0, bottomLine))
RemoveControl(arrTextVals(2, bottomLine))
RemoveControl(arrTextVals(4, bottomLine))
RemoveControl(arrTextVals(6, bottomLine))
tbline.Text = " "
End Sub
Private Sub RemoveControl(ControlName As String)
Dim ctr As Control
For Each ctr In Me.Controls
If ctr.Name = ControlName Then
Me.Controls.Remove(ctr)
Exit Sub
End If
Next ctr
End Sub
Related
I am attempting to load thousands of URLs into a list, then simultaneously download the webpage source of all of those URLs. I thought I had a clear understanding of how to accomplish this but it seems that the process goes 1 by 1 (which is painstakingly slow).
Is there a way to make this launch all of these URLs at once, or perhaps more than 1 at a time?
Public Partial Class MainForm
Dim ImportList As New ListBox
Dim URLList As String
Dim X1 As Integer
Dim CurIndex As Integer
Public Sub New()
Me.InitializeComponent()
End Sub
Sub MainFormLoad(sender As Object, e As EventArgs)
Try
Dim lines() As String = IO.File.ReadAllLines("C:\URLFile.txt")
ImportList.Items.AddRange(lines)
Catch ex As Exception
MessageBox.Show(ex.ToString)
Finally
label1.Text = "File Loaded"
X1 = ImportList.Items.Count
timer1.Enabled = True
If Not backgroundWorker1.IsBusy Then
backgroundWorker1.RunWorkerAsync()
End If
End Try
End Sub
Sub BackgroundWorker1DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs)
URLList = ""
For Each item As String In ImportList.Items
CheckName(item)
CurIndex = CurIndex + 1
Next
End Sub
Sub BW1_Completed()
timer1.Enabled = False
label1.Text = "Done"
End Sub
Sub CheckName(ByVal CurUrl As String)
Dim RawText As String
Try
RawText = New System.Net.WebClient().DownloadString(CurUrl)
Catch ex As Exception
MessageBox.Show(ex.ToString)
Finally
If RawText.Contains("404") Then
If URLList = "" Then
URLList = CurUrl
Else
URLList = URLList & vbCrLf & CurUrl
End If
End If
End Try
End Sub
Sub Timer1Tick(sender As Object, e As EventArgs)
label1.Text = CurIndex.ToString & " of " & X1.ToString
If Not URLList = "" Then
textBox1.Text = URLList
End If
End Sub
Sub Button1Click(sender As Object, e As EventArgs)
Clipboard.Clear
Clipboard.SetText(URLList)
End Sub
End Class
i'm trying to export list view item to excel sheet, every thing work perfect
but when I'm trying to do this in background worker i face this error :
An exception of type 'System.InvalidOperationException' occurred in System.Windows.Forms.dll but was not handled in user code
Additional information: Cross-thread operation not valid: Control 'ListView1' accessed from a thread other than the thread it was created on.
i dint know how to fix this , please help me :)
this is my code :
Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Click
Try
saveFileDialog1.Filter = "Excel File|*.xlsx"
saveFileDialog1.Title = "Save an Excel File"
Application.EnableVisualStyles()
If saveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
If saveFileDialog1.FileName <> "" Then
PictureBox1.Visible = True
BackgroundWorker1.RunWorkerAsync()
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
saveExcelFile(SaveFileDialog1.FileName)
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
PictureBox1.Visible = False
MessageBox.Show("DONE !!")
End Sub
Public Sub saveExcelFile(ByVal FileName As String)
'Try
Dim xls As New Excel.Application
Dim sheet As Excel.Worksheet
Dim i As Integer
xls.Workbooks.Add()
sheet = xls.ActiveWorkbook.ActiveSheet
Dim row As Integer = 1
Dim col As Integer = 1
For i = 0 To Me.ListView1.Columns.Count - 1
sheet.Cells(1, i + 1) = Me.ListView1.Columns(i).Text
Next
For i = 0 To Me.ListView1.Items.Count - 1
For j = 0 To Me.ListView1.Items(i).SubItems.Count - 1 ' here the ERROR !!
sheet.Cells(i + 2, j + 1) = Me.ListView1.Items(i).SubItems(j).Text
Next
Next
row += 1
col = 1
' for the header
sheet.Rows(1).Font.Name = "Microsoft Sans Serif"
sheet.Rows(1).Font.size = 16
sheet.Rows(1).Font.Bold = True
sheet.Rows(1).HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
Dim mycol As System.Drawing.Color = System.Drawing.ColorTranslator.FromHtml("#20b2aa")
sheet.Rows(1).Font.color = mycol
' for all the sheet without header
sheet.Range("a2", "z1000").Font.Name = "Arial"
sheet.Range("a2", "z1000").Font.Size = 14
sheet.Range("a2", "z1000").HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
sheet.Range("A1:X1").EntireColumn.AutoFit()
sheet.Range("A1:X1").EntireRow.AutoFit()
xls.ActiveWorkbook.SaveAs(FileName)
xls.Workbooks.Close()
xls.Quit()
'Catch ex As Exception
' MsgBox(ex.Message)
'End Try
End Sub
hello Enigmativity ...
i do what you say but i have small error :
An exception of type 'System.Runtime.InteropServices.COMException' occurred in Noor Phone.exe but was not handled in user code
Additional information: Unable to access the file. Try one of the following actions:
• Make sure that the selected folder.
• Make sure that the folder that contains the file is not read-only.
• Make sure the file name does not contain one of the following codes: <>? []: | Or *
• Make sure the file name and path name does not contain more than 128 characters.
this is my code after editing:
Private Class BgwData
Public FileName As String
Public Headers As String()
Public Data As String()()
End Class
Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Click
'Try
Dim data As New BgwData() With _
{ _
.FileName = SaveFileDialog1.FileName, _
.Headers = _
Me.ListView1.Columns _
.Cast(Of System.Windows.Forms.ColumnHeader)() _
.Select(Function(ch) ch.Name) _
.ToArray(), _
.Data = _
Me.ListView1.Items.Cast(Of ListViewItem)() _
.Select(Function(lvi) lvi.SubItems _
.Cast(Of ListViewItem.ListViewSubItem)() _
.Select(Function(lvsi) lvsi.Text) _
.ToArray()) _
.ToArray() _
}
'BackgroundWorker1.RunWorkerAsync(data)
SaveFileDialog1.Filter = "Excel File|*.xlsx"
SaveFileDialog1.Title = "Save an Excel File"
Application.EnableVisualStyles()
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
If SaveFileDialog1.FileName <> "" Then
PictureBox1.Visible = True
'BackgroundWorker1.RunWorkerAsync()
BackgroundWorker1.RunWorkerAsync(data)
End If
End If
'Catch ex As Exception
' MsgBox(ex.Message)
'End Try
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
'saveExcelFile(SaveFileDialog1.FileName)
saveExcelFile(CType(e.Argument, BgwData))
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
PictureBox1.Visible = False
MessageBox.Show("DONE !!")
End Sub
Private Sub saveExcelFile(ByVal data As BgwData)
'Public Sub saveExcelFile(ByVal FileName As String)
'Try
Dim xls As New Excel.Application
Dim sheet As Excel.Worksheet
Dim i As Integer
xls.Workbooks.Add()
sheet = xls.ActiveWorkbook.ActiveSheet
'Dim row As Integer = 1
'Dim col As Integer = 1
'For i = 0 To Me.ListView1.Columns.Count - 1
' sheet.Cells(1, i + 1) = Me.ListView1.Columns(i).Text
'Next
'For i = 0 To Me.ListView1.Items.Count - 1
' For j = 0 To Me.ListView1.Items(i).SubItems.Count - 1 ' here the ERROR !!
' sheet.Cells(i + 2, j + 1) = Me.ListView1.Items(i).SubItems(j).Text
' Next
'Next
Dim row As Integer = 1
Dim col As Integer = 1
For i = 0 To data.Headers.Length - 1
sheet.Cells(1, i + 1) = data.Headers(i)
Next
For i = 0 To data.Data.Length - 1
For j = 0 To data.Data(i).Length - 1
sheet.Cells(i + 2, j + 1) = data.Data(i)(j)
Next
Next
row += 1
col = 1
' for the header
sheet.Rows(1).Font.Name = "Microsoft Sans Serif"
sheet.Rows(1).Font.size = 16
sheet.Rows(1).Font.Bold = True
sheet.Rows(1).HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
Dim mycol As System.Drawing.Color = System.Drawing.ColorTranslator.FromHtml("#20b2aa")
sheet.Rows(1).Font.color = mycol
' for all the sheet without header
sheet.Range("a2", "z1000").Font.Name = "Arial"
sheet.Range("a2", "z1000").Font.Size = 14
sheet.Range("a2", "z1000").HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
sheet.Range("A1:X1").EntireColumn.AutoFit()
sheet.Range("A1:X1").EntireRow.AutoFit()
'xls.ActiveWorkbook.SaveAs(FileName)
xls.ActiveWorkbook.SaveAs(data.FileName)'**HERE THE ERROR**
xls.Workbooks.Close()
xls.Quit()
Marshal.ReleaseComObject(sheet)
Marshal.ReleaseComObject(xls)
'Catch ex As Exception
' MsgBox(ex.Message)
'End Try
End Sub
You should always make sure that when you access elements of the UI that you do so on the UI thread otherwise you can get the error you're experiencing.
The easiest way to avoid this issue is to separate out the code that reads the data from the UI and the code that writes your Excel file.
First start by defining a simple class to hold your data:
Private Class BgwData
Public FileName As String
Public Headers As String()
Public Data As String()()
End Class
I defined this inside the form class as it doesn't need to be exposed outside of the form.
Now the code that calls the background worker needs to change so that an instance of BgwData is created, populated with the data from the ListView, as well as the file name, and sent to the worker as its argument.
Dim data As New BgwData() With _
{ _
.FileName = saveFileDialog1.FileName, _
.Headers = _
Me.ListView1.Columns _
.Cast(Of System.Windows.Forms.ColumnHeader)() _
.Select(Function(ch) ch.Name) _
.ToArray(), _
.Data = _
Me.ListView1.Items.Cast(Of ListViewItem)() _
.Select(Function(lvi) lvi.SubItems _
.Cast(Of ListViewItem.ListViewSubItem)() _
.Select(Function(lvsi) lvsi.Text) _
.ToArray()) _
.ToArray() _
}
BackgroundWorker1.RunWorkerAsync(data)
This code runs in the PictureBox2_Click so is still on the UI thread.
The BackgroundWorker1_DoWork method changes slightly to call saveExcelFile like this:
saveExcelFile(CType(e.Argument, BgwData))
The signature for saveExcelFile changes to Private Sub saveExcelFile(ByVal data As BgwData)
And the code that populates the spreadsheet becomes:
Dim row As Integer = 1
Dim col As Integer = 1
For i = 0 To data.Headers.Length - 1
sheet.Cells(1, i + 1) = data.Headers(i)
Next
For i = 0 To data.Data.Length - 1
For j = 0 To data.Data(i).Length - 1
sheet.Cells(i + 2, j + 1) = data.Data(i)(j)
Next
Next
And, of course, there is a small change to the SaveAs method call to become:
xls.ActiveWorkbook.SaveAs(data.FileName)
Also, as a side note, do keep in mind that you need release your COM objects after you use them too:
Marshal.ReleaseComObject(sheet);
Marshal.ReleaseComObject(xls);
i found the answer all what i need is to add this line of code in the load form
CheckForIllegalCrossThreadCalls = False
thanks for helping
Is there a way to assign an item in a list box to a variable at a specific index with a loop with Option Strict On. its givin me the error "Option Strict On Disallows Late Binding." Error is at strSelected = lstCart.SelectedItem(index).ToString()
The loop basically needs to take each item in the list box, remove the first 20 characters(the name) and then trim the rest(the result is a price), then convert it to an integer using tryparse, then add it to the subtotal. After the program does this it displays the price in lblSub.Text
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Dim dblSubTotal As Double
Dim dblPrices() As Double = {4.99, 2.49, 6.49, 5.99, 11.99, 8.99, 4.49, 6.99, 0.99, 2.99}
Dim dblShipping As Double
Const SALES_TAX As Double = 0.04
Dim dblTax As Double
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
lstCds.Items.Add(("GardenKnomez").PadRight(20) & "- Across The Lawn")
lstCds.Items.Add(("The Pastries").PadRight(20) & "- Escape The Police")
lstCds.Items.Add(("Road Wasp").PadRight(20) & "- B Flat")
lstCds.Items.Add(("Paper Plated").PadRight(20) & "- Just Throw Us Away")
lstCds.Items.Add(("Exploding Bunions").PadRight(20) & "- Walk It Off")
lstCds.Items.Add(("NeverFart").PadRight(20) & "- Be Careful What You Wish For")
lstCds.Items.Add(("Hoth").PadRight(20) & "- In Michigan")
lstCds.Items.Add(("Naked Nation").PadRight(20) & "- Mabe SomeDay")
lstCds.Items.Add(("Poopsa").PadRight(20) & "- Pizza")
lstCds.Items.Add(("Hidden Valley").PadRight(20) & "- It's Only Ranch")
lstCds.SelectedIndex = 0
End Sub
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
Dim strArtist As String
Dim intIndexSelected As Integer = lstCds.SelectedIndex
If lstCds.SelectedIndex = -1 Then
MessageBox.Show("Please make a selection... preferably Exploding Bunions")
Else
strArtist = lstCds.SelectedItem.ToString
strArtist = strArtist.Remove(20)
strArtist = strArtist.Trim()
lstCart.Items.Add((strArtist).PadRight(20) & dblPrices(intIndexSelected).ToString("C2"))
'Display Sub Total
dblSubTotal += dblPrices(intIndexSelected)
lblSub.Text = dblSubTotal.ToString("C2")
'Display Tax
dblTax = dblSubTotal * SALES_TAX
lblTax.Text = dblTax.ToString("C2")
'Display Shipping
If lstCart.Items.Count >= 5 Then
dblShipping = 5
ElseIf lstCart.Items.Count > 0 AndAlso lstCart.Items.Count < 5 Then
dblShipping = lstCart.Items.Count
End If
lblShipping.Text = dblShipping.ToString("C2")
'Display Total
lblTotal.Text = (dblSubTotal + dblTax + dblShipping).ToString("C2")
lstCds.SelectedIndex = -1
lstCart.SelectedIndex = lstCart.Items.Count - 1
End If
End Sub
Private Sub btnRemove_Click(sender As Object, e As EventArgs) Handles btnRemove.Click
Dim intIndex As Integer
If lstCart.Items.Count = 0 Then
MessageBox.Show("Theres absolutely nothing in your cart, if you want to exit" &
" click ""FILE"" then click ""Exit""", "Discount Bin",
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
ElseIf lstCart.SelectedIndex = -1 Then
MessageBox.Show("Are you ok? You have nothing selected in your cart.", "Discount Bin",
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Else
lstCart.Items.RemoveAt(lstCart.SelectedIndex)
lstCds.SelectedIndex = 0
'subtract removed from subtotal
intIndex = lstCart.Items.Count - 1
dblSubTotal = 0
Dim strSelected As String
Dim dblSelected As Double
For index As Integer = 0 To intIndex
strSelected = lstCart.SelectedItem(index).ToString()
strSelected.Remove(0, 20)
strSelected.Trim()
Double.TryParse(strSelected, dblSelected)
dblSubTotal += dblSelected
Next index
lblSub.Text = dblSubTotal.ToString("C2")
'subtract removed from tax
End If
End Sub
Private Sub mnuFileExit_Click(sender As Object, e As EventArgs) Handles mnuFileExit.Click
If lstCart.Items.Count > 0 Then
Dim strPrice As String = lstCart.SelectedItem.ToString
strPrice = strPrice.Remove(0, 20)
strPrice = strPrice.Trim
strPrice.Insert(0, "$"c)
MessageBox.Show("We hope you enjoy your cd's because they're all pretty terrible," &
" especally the one for " & strPrice)
Else
MessageBox.Show("YOU'LL THANK YOURSELF LATER")
End If
Application.Exit()
End Sub
Private Sub mnuFileSave_Click(sender As Object, e As EventArgs) Handles mnuFileSave.Click
Dim outFile As IO.StreamWriter
If lstCart.Items.Count = 0 Then
MessageBox.Show("You dont have any items in your cart lol", "Discount Bin",
MessageBoxButtons.OK, MessageBoxIcon.Asterisk)
Else
outFile = IO.File.CreateText("ThoseCdsYouWishYouNeverBought.txt")
For index As Integer = 1 To lstCart.Items.Count
lstCart.SelectedIndex = index - 1
outFile.WriteLine(lstCart.SelectedItem)
Next
MessageBox.Show("Reciept printed to your bin directory, your gunna need that.", "Discount Bin",
MessageBoxButtons.OK, MessageBoxIcon.Information)
outFile.Close()
Dim result As DialogResult = MessageBox.Show("Do you want to keep shopping?", "Discount Bin",
MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = DialogResult.No Then
Application.Exit()
End If
End If
End Sub
Private Sub lstCart_MouseDown(sender As Object, e As MouseEventArgs) Handles lstCart.MouseDown
lstCds.SelectedIndex = -1
End Sub
End Class
this is incorrect:
Dim strSelected As String
For index As Integer = 0 To intIndex
strSelected = lstCart.SelectedItem(index).ToString()
Next index
lblSub.Text = dblSubTotal.ToString("C2")
SelectedItem is a single object, so you cant index it. to loop thru the SelectedItemS:
Dim n As Integer = 0 to lstCart.SelectedItems.Count - 1
strSelected = lstCart.SelectedItems(n)
' this is pointless because you do nothing with it
Next n
You can put class objects in the listbox, in which case when getting them back you need to convert/cast the Item object back to the correct Type (this is usually the case with that error message):
strName = CType(lstCart.SelectedItem, ItemClass).PropertyName
this would convert an object stored as the SelectedItem back to the Class type, so its props can be referenced. your code is a perfect candicate for a class - it would keep the name and price together rather than having to look things up in other arrays. As soon as you sort the listbox, the indicies no longer match and Gnomes points to the price for Garden Weasel
Edit
To remove the selected items:
For n as Integer = lstCart.SelectedItems.Count - 1 To 0 Step -1
' MUST loop backwards
lstCart.Items.Remove(lstCart.SelectedItems(n)
Next n
after the purge, reloop to recalc instead of subtracting.
Hi all im getting a null reference run time error with one line of code in my project, however if i break point it and then step through it everything works fine. Any Thoughts
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim checkbox_l As String = "CheckBox"
Dim checkbox_i As string
For i As Integer = 1 To id Step 1
checkbox_i = checkbox_l + i.ToString
Try
If CType(Panel1.Controls(checkbox_i), CheckBox).Checked = True Then
My.Settings.name = Panel1.Controls("CheckBox" & i).Text
Call installer_properties()
Call start_install()
End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Next
End Sub
The code is meant to check if a dynamically created checkbox has been checked and then move on accordingly, however im getting an error with the line
If CType(Panel1.Controls(checkbox_i), CheckBox).Checked = True Then
Use Debug.Assert to catch it
Dim c as Control = Panel1.Controls(checkbox_i)
Debug.Assert(c IsNot Nothing)
Dim cb as CheckBox = TryCast(c, CheckBox)
If cb isNot Nothing Then
If cb.Checked = True Then
My.Settings.name = cb.Text
Call installer_properties()
Call start_install()
End If
End If
To get result 1 if checked and 0 - if not, you can write down:
textbox1.text = Microsoft.VisualBasic.Right(Panel1.Controls("CheckBox" & i).ToString, 1)
When I start a thread, the ThreadState always is "Unstarted" even if I do a "Thread.Abort()", my thread starts and finish the work good... I don't know why I get that always the same state.
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(100)
While not thread_1.ThreadState = Threading.ThreadState.Running
MsgBox(thread_1.ThreadState.ToString) ' "Unstarted"
thread_1.Abort()
MsgBox(thread_1.ThreadState.ToString) ' "Unstarted" again and again...
End While
UPDATE
This is the sub who calls the thread, and the problem is the "while" statament is not waiting,
PS: You can see a comment explanation at the middle of this sub:
public sub...
...
If Not playerargs = Nothing Then
If randomize.Checked = True Then
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(50)
While thread_1.ThreadState = Threading.ThreadState.Running
Windows.Forms.Application.DoEvents()
End While
Else
progresslabel.Text = "All files added..."
End If
' HERE IS THE PROBLEM, IF I CHECK "AUTOCLOSE" CHECKBOX THEN,
' THE FORM ALWAYS TRY TO CLOSE BEFORE THREAD IS COMPLETED:
' -----------------------------------------
If autoclose.Checked = True Then Me.Close()
'------------------------------------------
Else
...
End Sub
And here is the "mithread" thread:
Public Sub mithread()
Dim Str As String
Dim Pattern As String = ControlChars.Quote
Dim ArgsArray() As String
Str = Replace(playerargs, " " & ControlChars.Quote, "")
ArgsArray = Split(Str, Pattern)
Using objWriter As New System.IO.StreamWriter(Temp_file, False, System.Text.Encoding.UTF8)
Dim n As Integer = 0
Dim count As Integer = 0
Dim foldercount As Integer = -1
For Each folder In ArgsArray
foldercount += 1
If foldercount > 1 Then
InvokeControl(ProgBarPlus1, Sub(x) x.Max = foldercount)
End If
Next
If foldercount = 1 Then
For Each folder In ArgsArray
If Not folder = Nothing Then
Dim di As New IO.DirectoryInfo(folder)
Dim files As IO.FileInfo() = di.GetFiles("*")
Dim file As IO.FileInfo
InvokeControl(ProgBarPlus1, Sub(x) x.Max = files.Count)
For Each file In files
n += 1
CheckPrimeNumber(n)
count += 1
If file.Extension.ToLower = ".lnk" Then
Dim ShotcutTarget As String = Shortcut.ResolveShortcut((file.FullName).ToString())
objWriter.Write(ShotcutTarget & vbCrLf)
Else
objWriter.Write(file.FullName & vbCrLf)
End If
Next
End If
Next
ElseIf foldercount > 1 Then
For Each folder In ArgsArray
If Not folder = Nothing Then
Dim di As New IO.DirectoryInfo(folder)
Dim files As IO.FileInfo() = di.GetFiles("*")
Dim file As IO.FileInfo
InvokeControl(ProgBarPlus1, Sub(x) x.Value += 1)
For Each file In files
If file.Extension.ToLower = ".lnk" Then
Dim ShotcutTarget As String = Shortcut.ResolveShortcut((file.FullName).ToString())
objWriter.Write(ShotcutTarget & vbCrLf)
Else
objWriter.Write(file.FullName & vbCrLf)
End If
Next
End If
Next
End If
End Using
If Not thread_1.ThreadState = Threading.ThreadState.AbortRequested Then
MsgBox(thread_1.ThreadState.ToString)
Randomize_a_file.RandomizeFile(Temp_file)
InvokeControl(ProgBarPlus1, Sub(x) x.Value = 0)
' Process.Start(userSelectedPlayerFilePath, ControlChars.Quote & Temp_file.ToString() & ControlChars.Quote)
InvokeControl(progresslabel, Sub(x) x.Text = "All files launched...")
End If
End Sub
Its not easy to work out what your problem is, but i can say for sure a While Loop and DoEvents is not the way forward at all.
Instead raise an event when the thread has done all its work, subscribe to the event, and when it is raise close the form (if autoclose = true):
Public Class Form1
Public Event threadCompleted()
Public Sub New()
InitializeComponent()
AddHandler threadCompleted, AddressOf Me.Thread_Completed
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim t1 As New Threading.Thread(AddressOf mithread)
t1.Start()
End Sub
Public Sub mithread()
'simulate some work:
Threading.Thread.Sleep(3000)
'then raise the event when done
RaiseEvent threadCompleted()
End Sub
Public Delegate Sub Thread_CompletedDelegate()
Private Sub Thread_Completed()
If Me.InvokeRequired Then
Me.BeginInvoke(New Thread_CompletedDelegate(AddressOf Thread_Completed))
Else
If autoclose.Checked = True Then
Me.Close()
End If
End If
End Sub
End Class
Or use a background worker which does all this, plus handles reporting progress and cancelation all for you.
Sounds like something is happening in mithread that is preventing the thread from fully starting. I ran similar code with an empty sub for mithread and I get the expected threadstate (Stopped then Aborted).
Sub Main()
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(100)
While Not thread_1.ThreadState = Threading.ThreadState.Running
Console.WriteLine(thread_1.ThreadState.ToString)
thread_1.Abort()
Console.WriteLine(thread_1.ThreadState.ToString)
If thread_1.ThreadState = Threading.ThreadState.Aborted Then Exit While
End While
End Sub
Sub mithread()
End Sub