Working with Visual Basic (+ DevExpress, WPF) and I've got the fields changing colours based on some validation checks, but the code duplication is bothersome. I feel as though implementing generics is the answer but am struggling with implementation.
Private Sub txt_LostFocus(sender As Object, e As RoutedEventArgs) Handles txtFileNo.LostFocus, txtDataLoc.LostFocus,
txtCltName.LostFocus, dtCurYE.LostFocus, dtPrevYE.LostFocus, seMinThres.LostFocus, cboDivType.LostFocus, cboCltType.LostFocus
Dim todim As String = sender.GetType.ToString
Select Case True
Case todim.EndsWith("TextBox")
makeTB(sender)
Case todim.EndsWith("DateEdit")
makeDE(sender)
Case todim.EndsWith("SpinEdit")
makeSE(sender)
Case todim.EndsWith("ComboBoxEdit")
makeCB(sender)
End Select
End Sub
Private Sub makeTB(sender As Object)
Dim btn As TextBox = CType(sender, TextBox)
If commandFN.bValidNewClient(btn.Name) Then
btn.Background = New SolidColorBrush(Colors.LawnGreen)
Else
btn.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
Private Sub makeDE(sender As Object)
Dim btn As DateEdit = CType(sender, DateEdit)
If commandFN.bValidNewClient(btn.Name) Then
btn.Background = New SolidColorBrush(Colors.LawnGreen)
Else
btn.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
Private Sub makeSE(sender As Object)
Dim btn As SpinEdit = CType(sender, SpinEdit)
If commandFN.bValidNewClient(btn.Name) Then
btn.Background = New SolidColorBrush(Colors.LawnGreen)
Else
btn.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
Private Sub makeCB(sender As Object)
Dim btn As ComboBoxEdit = CType(sender, ComboBoxEdit)
If commandFN.bValidNewClient(btn.Name) Then
btn.Background = New SolidColorBrush(Colors.LawnGreen)
Else
btn.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
Why don't you simply cast the sender argument to Control?:
Private Sub txt_LostFocus(sender As Object, e As RoutedEventArgs) Handles txtFileNo.LostFocus, txtDataLoc.LostFocus,
txtCltName.LostFocus, dtCurYE.LostFocus, dtPrevYE.LostFocus, seMinThres.LostFocus, cboDivType.LostFocus, cboCltType.LostFocus
Dim obj As Control = TryCast(sender, Control)
If obj IsNot Nothing Then
make(obj)
End If
End Sub
Private Sub make(sender As Control)
If commandFN.bValidNewClient(sender.Name) Then
sender.Background = New SolidColorBrush(Colors.LawnGreen)
Else
sender.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
In this instance you can just use the base class, Control, rather than writing a method using generics:
Private Sub txt_LostFocus(sender As Object, e As RoutedEventArgs) Handles txtFileNo.LostFocus, txtDataLoc.LostFocus,
txtCltName.LostFocus, dtCurYE.LostFocus, dtPrevYE.LostFocus, seMinThres.LostFocus, cboDivType.LostFocus, cboCltType.LostFocus
Dim todim As String = sender.GetType.ToString
Dim btn As Control = CType(sender, Control) 'Cast to base class here
If commandFN.bValidNewClient(btn.Name) Then
btn.Background = New SolidColorBrush(Colors.LawnGreen)
Else
btn.Background = New SolidColorBrush(Colors.Red)
End If
End Sub
Related
Hi guys i've been working so far with my system and it's almost done, but there is one thing i can't solve yet(not unless if you help me out).
so here's my code:
Private Sub btnEditmain_Click(sender As Object, e As EventArgs) Handles btnEditmain.Click
Try
editdgv()
Form2.Show()
DataGridView2.AllowUserToAddRows = True
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
here's the private sub editdgv
Private Sub editdgv()
Dim i = DataGridView2.CurrentRow.Index
With DataGridView2
Form2.txtPeriod.Text = IIf(IsDBNull(.Rows(i).Cells("period").Value), " ", .Rows(i).Cells("period").Value)
Form2.txtVouch.Text = IIf(IsDBNull(.Rows(i).Cells("vouch_amt").Value), " ", .Rows(i).Cells("vouch_amt").Value)
Form2.txtIndivAmt.Text = IIf(IsDBNull(.Rows(i).Cells("individual_amt").Value), " ", .Rows(i).Cells("individual_amt").Value)
Form2.txtCheckno.Text = IIf(IsDBNull(.Rows(i).Cells("check_no").Value), " ", .Rows(i).Cells("check_no").Value)
Form2.txtDmailed.Text = IIf(IsDBNull(.Rows(i).Cells("D_MAILED").Value), " ", .Rows(i).Cells("D_MAILED").Value)
Form2.txtDirno.Text = IIf(IsDBNull(.Rows(i).Cells("DIR_NO").Value), " ", .Rows(i).Cells("DIR_NO").Value)
Form2.txtYrlvl.Text = IIf(IsDBNull(.Rows(i).Cells("year_student").Value), " ", .Rows(i).Cells("year_student").Value)
Form2.txtUpdatedBy.Text = IIf(IsDBNull(.Rows(i).Cells("who_updated").Value), " ", .Rows(i).Cells("who_updated").Value)
End With
End Sub
i was able to pass the value of the selected rows in datagridview to another form(textbox)
all things are working fine from there..
Now what i wanna do is to update that selected datagridview which is now in my textbox(s).
through a button click.
now i'm stuck at saving changes that i've done in the textbox, so it will be updated on the database.
pls help me on how to update the selected row in datagridview in textbox via button click.
thanks!
Public Class Form2
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
End Sub
End Class
I have created this code in notepad. So, it might have some issue.
FORM 1
Private Sub btnEditmain_Click(sender As Object, e As EventArgs) Handles btnEditmain.Click
Try
Dim dt As DataTable = TryCast(DataGridView2.DataSource, DataTable)
Dim dr As DataRow = dt.Rows(DataGridView2.CurrentRow.Index)
Dim frm As New Form2
frm.dr = dr
frm.Show()
DataGridView2.AllowUserToAddRows = True
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
FORM 2
Public dr As DataRow = Nothing
Private Sub Form2_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
With dr
txtPeriod.Text = IIf(IsDBNull(.Item("period")), vbNullString, .Item("period").ToString)
txtVouch.Text = IIf(IsDBNull(.Item("vouch_amt")), vbNullString, .Item("vouch_amt").ToString)
txtIndivAmt.Text = IIf(IsDBNull(.Item("individual_amt")), vbNullString, .Item("individual_amt").ToString)
txtCheckno.Text = IIf(IsDBNull(.Item("check_no")), vbNullString, .Item("check_no").ToString)
txtDmailed.Text = IIf(IsDBNull(.Item("D_MAILED")), vbNullString, .Item("D_MAILED").ToString)
txtDirno.Text = IIf(IsDBNull(.Item("DIR_NO")), vbNullString, .Item("DIR_NO").ToString)
txtYrlvl.Text = IIf(IsDBNull(.Item("year_student")), vbNullString, .Item("year_student").ToString)
txtUpdatedBy.Text = IIf(IsDBNull(.Item("who_updated")), vbNullString, .Item("who_updated").ToString)
End With
End Sub
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
With dr
.Item("period") = txtPeriod.Text
.Item("vouch_amt") = txtVouch.Text
.Item("individual_amt") = txtIndivAmt.Text
.Item("check_no") = txtCheckno.Text
.Item("D_MAILED") = txtDmailed.Text
.Item("DIR_NO") = txtDirno.Text
.Item("year_student") = txtYrlvl.Text
.Item("who_updated") = txtUpdatedBy.Text
End With
dr.Table.AcceptChanges
End Sub
i'm building a slide puzzle in wpf (VB.NET- Visual Studio 2012) and i alredy wrote the code for it but i need to had a stopwatch that will appear at the window loading first time. i also need that the stopwatch will be elapsed and start again when the user shuffles the puzzle. please give me some tips to write the right code. thx.
that's the code for the slide puzzle:
Public Class level2
Dim win(15) As BitmapImage
Dim wrong(15) As BitmapImage
Dim mess(15) As BitmapImage
Dim images(15) As Image
Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Dim h1 As New BitmapImage
h1.BeginInit()
h1.UriSource = New Uri("images2/h1.gif", UriKind.RelativeOrAbsolute)
h1.EndInit()
Dim h2 As New BitmapImage
h2.BeginInit()
h2.UriSource = New Uri("images2/h2.gif", UriKind.RelativeOrAbsolute)
h2.EndInit()
Dim h3 As New BitmapImage
h3.BeginInit()
h3.UriSource = New Uri("images2/h3.gif", UriKind.RelativeOrAbsolute)
h3.EndInit()
Dim h4 As New BitmapImage
h4.BeginInit()
h4.UriSource = New Uri("images2/h4.gif", UriKind.RelativeOrAbsolute)
h4.EndInit()
Dim h5 As New BitmapImage
h5.BeginInit()
h5.UriSource = New Uri("images2/h5.gif", UriKind.RelativeOrAbsolute)
h5.EndInit()
Dim h6 As New BitmapImage
h6.BeginInit()
h6.UriSource = New Uri("images2/h6.gif", UriKind.RelativeOrAbsolute)
h6.EndInit()
Dim h7 As New BitmapImage
h7.BeginInit()
h7.UriSource = New Uri("images2/h7.gif", UriKind.RelativeOrAbsolute)
h7.EndInit()
Dim h8 As New BitmapImage
h8.BeginInit()
h8.UriSource = New Uri("images2/h8.gif", UriKind.RelativeOrAbsolute)
h8.EndInit()
Dim h9 As New BitmapImage
h9.BeginInit()
h9.UriSource = New Uri("images2/h9.gif", UriKind.RelativeOrAbsolute)
h9.EndInit()
Dim h10 As New BitmapImage
h10.BeginInit()
h10.UriSource = New Uri("images2/h10.gif", UriKind.RelativeOrAbsolute)
h10.EndInit()
Dim h11 As New BitmapImage
h11.BeginInit()
h11.UriSource = New Uri("images2/h11.gif", UriKind.RelativeOrAbsolute)
h11.EndInit()
Dim h12 As New BitmapImage
h12.BeginInit()
h12.UriSource = New Uri("images2/h12.gif", UriKind.RelativeOrAbsolute)
h12.EndInit()
Dim h13 As New BitmapImage
h13.BeginInit()
h13.UriSource = New Uri("images2/h13.gif", UriKind.RelativeOrAbsolute)
h13.EndInit()
Dim h14 As New BitmapImage
h14.BeginInit()
h14.UriSource = New Uri("images2/h14.gif", UriKind.RelativeOrAbsolute)
h14.EndInit()
Dim h15 As New BitmapImage
h15.BeginInit()
h15.UriSource = New Uri("images2/h15.gif", UriKind.RelativeOrAbsolute)
h15.EndInit()
win(0) = h1
win(1) = h2
win(2) = h3
win(3) = h4
win(4) = h5
win(5) = h6
win(6) = h7
win(7) = h8
win(8) = h9
win(9) = h10
win(10) = h11
win(11) = h12
win(12) = h13
win(13) = h14
win(14) = h15
win(15) = Nothing
wrong(0) = h4
wrong(1) = h1
wrong(2) = h7
wrong(3) = h14
wrong(4) = h5
wrong(5) = h13
wrong(6) = h8
wrong(7) = h10
wrong(8) = h6
wrong(9) = h2
wrong(10) = h12
wrong(11) = h15
wrong(12) = h3
wrong(13) = h11
wrong(14) = h9
wrong(15) = Nothing
images(0) = flower0
images(1) = flower1
images(2) = flower2
images(3) = flower3
images(4) = flower4
images(5) = flower5
images(6) = flower6
images(7) = flower7
images(8) = flower8
images(9) = flower9
images(10) = flower10
images(11) = flower11
images(12) = flower12
images(13) = flower13
images(14) = flower14
images(15) = flower15
For i As Integer = 0 To wrong.Length - 1
images(i).Source = wrong(i)
Next
End Sub
Sub checkwin()
Dim flag As Boolean = False
For i As Integer = 0 To win.Length - 1
If mess(i) Is win(i) Then
flag = True
Else
flag = False
Exit For
End If
Next
If flag = True Then
lbl2.Content = "You Win!!"
End If
End Sub
Sub checkcells(ByRef pic1 As Image, ByRef pic2 As Image)
If pic2.Source Is Nothing Then
pic2.Source = pic1.Source
pic1.Source = Nothing
End If
End Sub
Sub update()
For i As Integer = 0 To mess.Length - 1
mess(i) = images(i).Source
Next
End Sub
Private Sub flower0_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower0.MouseDown
checkcells(flower0, flower1)
checkcells(flower0, flower4)
update()
checkwin()
End Sub
Private Sub flower1_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower1.MouseDown
checkcells(flower1, flower0)
checkcells(flower1, flower2)
checkcells(flower1, flower5)
update()
checkwin()
End Sub
Private Sub flower2_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower2.MouseDown
checkcells(flower2, flower1)
checkcells(flower2, flower3)
checkcells(flower2, flower6)
update()
checkwin()
End Sub
Private Sub flower3_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower3.MouseDown
checkcells(flower3, flower2)
checkcells(flower3, flower7)
update()
checkwin()
End Sub
Private Sub flower4_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower4.MouseDown
checkcells(flower4, flower0)
checkcells(flower4, flower5)
checkcells(flower4, flower8)
update()
checkwin()
End Sub
Private Sub flower5_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower5.MouseDown
checkcells(flower5, flower1)
checkcells(flower5, flower4)
checkcells(flower5, flower6)
checkcells(flower5, flower9)
update()
checkwin()
End Sub
Private Sub flower6_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower6.MouseDown
checkcells(flower6, flower2)
checkcells(flower6, flower5)
checkcells(flower6, flower7)
checkcells(flower6, flower10)
update()
checkwin()
End Sub
Private Sub flower7_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower7.MouseDown
checkcells(flower7, flower3)
checkcells(flower7, flower6)
checkcells(flower7, flower11)
update()
checkwin()
End Sub
Private Sub flower8_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower8.MouseDown
checkcells(flower8, flower4)
checkcells(flower8, flower9)
checkcells(flower8, flower12)
update()
checkwin()
End Sub
Private Sub flower9_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower9.MouseDown
checkcells(flower9, flower5)
checkcells(flower9, flower8)
checkcells(flower9, flower10)
checkcells(flower9, flower13)
update()
checkwin()
End Sub
Private Sub flower10_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower10.MouseDown
checkcells(flower10, flower6)
checkcells(flower10, flower9)
checkcells(flower10, flower11)
checkcells(flower10, flower14)
update()
checkwin()
End Sub
Private Sub flower11_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower11.MouseDown
checkcells(flower11, flower7)
checkcells(flower11, flower10)
checkcells(flower11, flower15)
update()
checkwin()
End Sub
Private Sub flower12_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower12.MouseDown
checkcells(flower12, flower8)
checkcells(flower12, flower13)
update()
checkwin()
End Sub
Private Sub flower13_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower13.MouseDown
checkcells(flower13, flower9)
checkcells(flower13, flower12)
checkcells(flower13, flower14)
update()
checkwin()
End Sub
Private Sub flower14_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower14.MouseDown
checkcells(flower14, flower10)
checkcells(flower14, flower13)
checkcells(flower14, flower15)
update()
checkwin()
End Sub
Private Sub flower15_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles flower15.MouseDown
checkcells(flower15, flower11)
checkcells(flower15, flower14)
update()
checkwin()
End Sub
Private Sub btnmix_Click(sender As Object, e As RoutedEventArgs) Handles btnmix.Click
Randomize()
Dim num(15) As Integer
Dim rnd1 As Integer
For i As Integer = 0 To 15
rnd1 = Int(Rnd() * (16 - 1) + 1)
Dim flag As Boolean = False
Do While flag = False
For x As Integer = 0 To 15
If rnd1 = num(x) Then
flag = True
End If
Next
If flag = True Then
flag = False
rnd1 = Int(Rnd() * (16 - 1) + 1)
Else
flag = True
End If
Loop
num(i) = rnd1
Dim h16 As New BitmapImage
h16.BeginInit()
h16.UriSource = New Uri("images2/h" & rnd1 & ".gif", UriKind.RelativeOrAbsolute)
h16.EndInit()
images(i).Source = h16
Next
End Sub
'Private Sub hint_Click(sender As Object, e As RoutedEventArgs) Handles hint.Click
' Dim monaLisa As New BitmapImage
' monaLisa.BeginInit()
' monaLisa.UriSource = New Uri("images/monalisa.jpg", UriKind.RelativeOrAbsolute)
' monaLisa.EndInit()
' showMona.Source = monaLisa
'End Sub
End Class
If you make the stopwatch declaration in the class root , then initiate and start it in the window.loaded event and then reset it when the user shuffles the puzzle
Anyone can share the code for the DomainCollectionView in VB.NET?
I have an error, Argument not specified for parameter 'op' of 'Private Sub OnLoadProductPMListCompleted(op As System.ServiceModel.DomainServices.Client.LoadOperation(Of ProductPM))'.
Public Sub New()
InitializeComponent()
Dim collectionViewLoader As DomainCollectionViewLoader(Of ProductPM)
collectionViewLoader = New DomainCollectionViewLoader(Of ProductPM)(Function() Me.LoadProductPMList(), Me.OnLoadProductPMListCompleted)
ProductCollectionView = New DomainCollectionView(collectionViewLoader, Products)
ProductCollectionView.Refresh()
Me.ProductListBox.ItemsSource = ProductCollectionView
End Sub
Public Function LoadProductPMList() As LoadOperation(Of ProductPM)
Dim qry As EntityQuery(Of ProductPM) = context.GetProductsQuery
Return context.Load(qry)
End Function
Private Sub OnLoadProductPMListCompleted(op As LoadOperation(Of ProductPM))
If op.HasError = True Then
ElseIf op.IsCanceled = False Then
CType(Products, EntityList(Of ProductPM)).Source = op.Entities
End If
End Sub
Sorry for the late reply, I have been busy. I've corrected the code, as noted below:
Dim context As ProductPMContext
Dim productCollectionView As DomainCollectionView
Dim products As IEnumerable(Of ProductPM)
Public Sub New()
InitializeComponent()
context = New ProductPMContext()
'You need to initialise the products collection
products = New EntityList(Of ProductPM)(context.ProductPMs)
Dim collectionViewLoader As DomainCollectionViewLoader(Of ProductPM)
'Have fixed this line, using AddressOf
collectionViewLoader = New DomainCollectionViewLoader(Of ProductPM)(AddressOf LoadProductPMList, AddressOf OnLoadProductPMListCompleted)
productCollectionView = New DomainCollectionView(collectionViewLoader, products)
productCollectionView.Refresh()
ProductListBox.ItemsSource = productCollectionView
End Sub
Public Function LoadProductPMList() As LoadOperation(Of ProductPM)
Return context.Load(context.GetProductsQuery)
End Function
Private Sub OnLoadProductPMListCompleted(ByVal op As LoadOperation(Of ProductPM))
If op.HasError = True Then
ElseIf op.IsCanceled = False Then
CType(products, EntityList(Of ProductPM)).Source = op.Entities
End If
End Sub
Hope this helps...
Chris
I had a similar question for DatagridComboboxColumn but that shown me how to use the .itemsource to bind to an array outside of the datagrid. I am having a problem trying to bind to the collection that the datagrid is bound to at runtime.
I have included a working test program for how I am approaching this.
Class MainWindow
Dim ServerInfoArray As List(Of ServerInfo) = New List(Of ServerInfo)
Private Sub GetInfo(ByVal list As List(Of String))
For Each server As String In list
Dim tempip As ComboBoxItem = New ComboBoxItem
Dim tempip2 As ComboBoxItem = New ComboBoxItem
Dim sinfo As ServerInfo = New ServerInfo
tempip.Content = "192.129.123.23"
tempip2.Content = "23.213.223.21"
sinfo.IPArray.Items.Add(tempip)
sinfo.IPArray.Items.Add(tempip2)
sinfo.ServerName = server
ServerInfoArray.Add(sinfo)
DataGrid1.Items.Refresh()
Next
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles Button1.Click
Dim serverlist As List(Of String) = New List(Of String)
serverlist.Add("Test")
serverlist.Add("Random")
serverlist.Add("Local")
GetInfo(serverlist)
End Sub
Private Sub Window_Loaded(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles MyBase.Loaded
Dim Col_Serial As DataGridTextColumn = New DataGridTextColumn()
Col_Serial.Binding = New Binding("Servername")
Col_Serial.Header = "Servername"
Col_Serial.Width = 40
Dim Col_IPArray = New DataGridComboBoxColumn()
Col_IPArray.Header = "IP Addresses"
Col_IPArray.IsReadOnly = True
'Col_IPArray.ItemsSource = serverInfoArray ' Don't know how to do this.
Col_IPArray.SelectedValuePath = "IPArray"
Col_IPArray.DisplayMemberPath = "IPArray"
DataGrid1.Columns.Add(Col_Serial)
DataGrid1.Columns.Add(Col_IPArray)
DataGrid1.ItemsSource = ServerInfoArray
End Sub
End Class
Class ServerInfo
Dim _Servername As String
Dim _IPArray As ComboBox
Public Property Servername() As String
Get
Return _Servername
End Get
Set(ByVal value As String)
_Servername = value
End Set
End Property
Public Property IPArray As ComboBox
Get
Return _IPArray
End Get
Set(ByVal value As ComboBox)
_IPArray = value
End Set
End Property
Public Sub New()
_Servername = Nothing
_IPArray = New ComboBox
End Sub
End Class
I can get all Strings and Boolean to bind.
I do not know how I can bind this DataGridComboBoxColumn to the list of attached on the property. I cannot use XAML as I need to do this at runtime.
Dim Col_Serial As DataGridComboColumn = New DataGridComboColumn()
Col_Serial.ItemSource = GetData();
Col_Serial.SelectedValuePath = "ID_value";
Col_Serial.DisplayMemberPath = "displya_col";
Col_Serial.Header = "Disk4"
Col_Serial.Width = 40
Col_Serial.IsEnabled= false;
dg.Columns.Add(Col_serial);
What's wrong in my code? It's not updating the TextBox and the ProgressBar while deleting files.
Imports System.Windows.Threading
Imports System.IO
Class MainWindow
Private Sub bt_Click(ByVal sender As Object,
ByVal e As RoutedEventArgs) Handles bt.Click
Dim sb As New System.Text.StringBuilder
Dim files = IO.Directory.EnumerateFiles(
My.Computer.FileSystem.SpecialDirectories.Temp, "*.*",
SearchOption.TopDirectoryOnly)
Dim count = files.Count
pb.Minimum = 0
pb.Maximum = count
For i = 0 To count - 1
Dim f = files(i)
Dispatcher.BeginInvoke(
New Action(Of String, Integer)(
Sub(str, int)
tb.SetValue(TextBox.TextProperty, str)
pb.SetValue(ProgressBar.ValueProperty, int)
End Sub),
DispatcherPriority.Send,
f, i + 1)
Try
File.Delete(f)
Catch ex As Exception
sb.AppendLine(f)
End Try
Dim exceptions = sb.ToString
Stop
Next
End Sub
End Class
I got this working with the BackgroundWorker object. This places your work in a background thread, with calls to update the UI going through the ProgressChanged event. I also used Invoke instead of BeginInvoke within the work loop, which forces the loop to wait for the UI to become updated before it proceeds.
Imports System.ComponentModel
Imports System.IO
Class MainWindow
Private WithEvents bw As New BackgroundWorker
Private Sub Button1_Click(ByVal sender As System.Object,
ByVal e As RoutedEventArgs) Handles btn.Click
pb.Minimum = 0
pb.Maximum = 100
bw.WorkerReportsProgress = True
bw.RunWorkerAsync()
End Sub
Private Sub bw_DoWork(ByVal sender As Object,
ByVal e As DoWorkEventArgs) Handles bw.DoWork
Dim sb As New System.Text.StringBuilder
Dim files = IO.Directory.EnumerateFiles(
My.Computer.FileSystem.SpecialDirectories.Temp, "*.*",
SearchOption.TopDirectoryOnly)
Dim count = files.Count
Me.Dispatcher.BeginInvoke(Sub()
tb.Text = "SOMETHING ELSE"
End Sub)
For i = 0 To count - 1
Dim f = files(i)
Dim myI = i + 1
Me.Dispatcher.Invoke(
Sub()
bw.ReportProgress(CInt((myI / count) * 100), f)
End Sub)
'Try
' File.Delete(f)
'Catch ex As Exception
' sb.AppendLine(f)
'End Try
Dim exceptions = sb.ToString
'Stop
Next
End Sub
Private Sub bw_ProgressChanged(
ByVal sender As Object,
ByVal e As ProgressChangedEventArgs) Handles bw.ProgressChanged
Dim fString As String = TryCast(e.UserState, String)
Me.Dispatcher.BeginInvoke(Sub()
tb.Text = fString
End Sub)
End Sub
End Class