I have a compare button which starts a background worker.
Private Sub btnCompare_Click(sender As Object, e As EventArgs) Handles btnCompare.Click
m_ProgressBar = New ProgressBar
m_ProgressBar.Show()
m_ProgressBar.txtBlockMainProgress.Dispatcher.BeginInvoke(Sub()
m_ProgressBar.txtBlockMainProgress.Text = "Comparing excel file(s)... Please wait. This might take a while."
End Sub)
Me.backgroundWorker = New BackgroundWorker
Me.backgroundWorker.WorkerReportsProgress = True
Me.backgroundWorker.WorkerSupportsCancellation = True
AddHandler Me.backgroundWorker.DoWork, AddressOf worker_DoWork
AddHandler Me.backgroundWorker.ProgressChanged, AddressOf worker_ProgressChanged
AddHandler Me.backgroundWorker.RunWorkerCompleted, AddressOf worker_RunWorkerCompleted
Me.backgroundWorker.RunWorkerAsync()
TaskbarItemInfo.ProgressState = Shell.TaskbarItemProgressState.Normal
End Sub
The DoWork Event of my backgroundworker initialize a class Compare that has a method named Compare which accept a backgroundworker as parameter
Private Sub worker_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
blnCompareDone = True
objExcelCompare = New Compare
With objExcelCompare
.SetThreshold = dblThreshold
.CompareToBestMatchData = blnBestMatchFlg
.CompareMerge = blnCompareMerge
.CompareTextWrap = blnCompareTextWrap
.CompareTextAlign = blnCompareTextAlign
.CompareOrientation = blnCompareOrientation
.CompareBorder = blnCompareBorder
.CompareBackColor = blnCompareBackColor
.CompareFont = blnCompareFont
.NoOfPages = intNoOfPages
.Page_Location_1 = objLocation_1
.Page_Location_2 = objLocation_2
.RemovedColumn = objRemoveCol
.RemovedRow = objRemoveRow
.AddedColumn = objAddCol
.AddedRow = objAddRow
.DataChange = objChangeData
.Compare(objWorksheet_1, objWorksheet_2, Me.backgroundWorker, e)
objEquivalentColumns = .EquivalentColumns
objEquivalentRows = .EquivalentRows
objValueResult_1 = .ValueResult_1
objValueResult_2 = .ValueResult_2
objFormatResult = .FormatResult
End With
End Sub
Inside the compare method i use ReportProgress to update my UI after comparing each page of excel file. There are total of 2 pages so the updating of progress bar will be 50% then 100%.
Public Sub Compare(ByRef p_objWorkSheet_1 As Worksheet, ByRef p_objWorkSheet_2 As Worksheet, ByRef p_backgroundWorker As BackgroundWorker, ByRef e As System.ComponentModel.DoWorkEventArgs)
If p_objWorkSheet_1 Is Nothing OrElse p_objWorkSheet_2 Is Nothing Then
'Error when no instance on either worksheets was found
Throw New Exception("No instances of worksheet is found.")
Exit Sub
End If
'********************Start of Comparison*********************
objExcelData_1 = New Dictionary(Of Integer, Dictionary(Of Tuple(Of Integer, Integer), Range))
objExcelData_2 = New Dictionary(Of Integer, Dictionary(Of Tuple(Of Integer, Integer), Range))
objEquivalentColumns = New Dictionary(Of Integer, Dictionary(Of Integer, Integer))
objEquivalentRows = New Dictionary(Of Integer, Dictionary(Of Integer, Integer))
objValueResult_1 = New Dictionary(Of Integer, Dictionary(Of Tuple(Of Integer, Integer), List(Of ValueError)))
objValueResult_2 = New Dictionary(Of Integer, Dictionary(Of Tuple(Of Integer, Integer), List(Of ValueError)))
objFormatResult = New Dictionary(Of Integer, Dictionary(Of Tuple(Of Integer, Integer), List(Of FormatError)))
'Loop through all pages
For w_intCtr_1 As Integer = 1 To intNoOfPages
If p_backgroundWorker.CancellationPending = True Then
e.Cancel = True
Return
End If
Dim w_intCurrentStep As Integer = 1
GetExcelData(p_objWorkSheet_1, objExcelData_1, objLocation_1, w_intCtr_1)
GetExcelData(p_objWorkSheet_2, objExcelData_2, objLocation_2, w_intCtr_1)
If objExcelData_1 Is Nothing OrElse objExcelData_2 Is Nothing Then
'No data to compare
Exit Sub
End If
objCompareByData = New Compare_Data
'Compare value of excelsheets
With objCompareByData
'Set threshold, excel data, and location of page to compare
.SetThreshold = dblThreshold
.CompareToBestMatchData = blnBestMatchFlg
.SetExcelData_1 = objExcelData_1(w_intCtr_1)
.SetLocation_1 = objLocation_1(w_intCtr_1)
.SetExcelData_2 = objExcelData_2(w_intCtr_1)
.SetLocation_2 = objLocation_2(w_intCtr_1)
If objRemoveCol Is Nothing = False AndAlso objRemoveCol.ContainsKey(w_intCtr_1) Then
.SetRemovedColumn = objRemoveCol(w_intCtr_1)
End If
If objRemoveRow Is Nothing = False AndAlso objRemoveRow.ContainsKey(w_intCtr_1) Then
.SetRemovedRow = objRemoveRow(w_intCtr_1)
End If
If objAddCol Is Nothing = False AndAlso objAddCol.ContainsKey(w_intCtr_1) Then
.SetAddedColumn = objAddCol(w_intCtr_1)
End If
If objAddRow Is Nothing = False AndAlso objAddRow.ContainsKey(w_intCtr_1) Then
.SetAddedRow = objAddRow(w_intCtr_1)
End If
If objChangeData Is Nothing = False AndAlso objChangeData.ContainsKey(w_intCtr_1) Then
.SetDataChange = objChangeData(w_intCtr_1)
End If
If p_backgroundWorker.CancellationPending = True Then
e.Cancel = True
Return
End If
'Proceed to compare
.Compare()
objEquivalentColumns.Add(w_intCtr_1, .EquivalentColumns)
objEquivalentRows.Add(w_intCtr_1, .EquivalentRows)
objValueResult_1.Add(w_intCtr_1, .ExcelData_Result_1)
objValueResult_2.Add(w_intCtr_1, .ExcelData_Result_2)
End With
If blnCompareMerge OrElse blnCompareTextWrap OrElse blnCompareTextAlign OrElse blnCompareOrientation OrElse blnCompareBorder OrElse blnCompareBackColor OrElse blnCompareFont Then
objCompareByFormat = New Compare_Format
'Compare format of excelsheets
With objCompareByFormat
'Set excel data to compare
.SetExcelFormat_1 = objExcelData_1(w_intCtr_1)
.SetExcelFormat_2 = objExcelData_2(w_intCtr_1)
'Set equivalent columns of page retrieved from comparing values of both excel sheets
'Set equivalent rows of page retrieved from comparing values of both excel sheets
If objEquivalentColumns Is Nothing = False AndAlso objEquivalentColumns.ContainsKey(w_intCtr_1) Then
.SetEquivalentColumns = objEquivalentColumns(w_intCtr_1)
End If
If objEquivalentRows Is Nothing = False AndAlso objEquivalentRows.ContainsKey(w_intCtr_1) Then
.SetEquivalentRows = objEquivalentRows(w_intCtr_1)
End If
.CompareMerge = blnCompareMerge
.CompareTextWrap = blnCompareTextWrap
.CompareTextAlign = blnCompareTextAlign
.CompareOrientation = blnCompareOrientation
.CompareBorder = blnCompareBorder
.CompareBackColor = blnCompareBackColor
.CompareFont = blnCompareFont
If p_backgroundWorker.CancellationPending = True Then
e.Cancel = True
Return
End If
.Compare()
'Set comparison result of page to collection
objFormatResult.Add(w_intCtr_1, .ExcelFormat_Result)
End With
End If
If p_backgroundWorker.CancellationPending = True Then
e.Cancel = True
Return
End If
'Set result to excel sheets
AddValueResultToWorkSheet(p_objWorkSheet_1, p_objWorkSheet_2, w_intCtr_1)
If p_backgroundWorker.CancellationPending = True Then
e.Cancel = True
Return
End If
'Set result to excel sheets
AddFormatResultToWorkSheet(p_objWorkSheet_2, w_intCtr_1)
p_backgroundWorker.ReportProgress((100 / intNoOfPages) * w_intCtr_1, (100 / intNoOfPages) * w_intCtr_1 & "% Completed " & w_intCtr_1 & " out of " & intNoOfPages & " pages")
Thread.Sleep(3000)
Next
End Sub
It works fine if i put Thread.Sleep(3000) after every ReportProgress. This is my ProgressChanged event handler
Private Sub worker_ProgressChanged(sender As Object, e As ProgressChangedEventArgs)
m_ProgressBar.pbStatusMain.Dispatcher.BeginInvoke(Sub()
m_ProgressBar.pbStatusMain.IsIndeterminate = False
m_ProgressBar.pbStatusMain.Value = e.ProgressPercentage
End Sub)
m_ProgressBar.txtBlockMainProgress.Dispatcher.BeginInvoke(Sub()
m_ProgressBar.txtBlockMainProgress.Text = e.UserState
End Sub)
TaskbarItemInfo.ProgressValue = e.ProgressPercentage / 100
End Sub
I wonder why sometimes it work and sometimes it doesnt. Based on my research the UI thread is being flooded with message causing it to be unresponsive or I used ReportProgress to frequent which causing the UI thread to ignore the next request. What am i doing wrong? Why the changes doesnt apply in my UI?
Related
Following my previous question answered by #Andrew Morton, I have one more :)
Here is my whole code (not very long for now) :
Imports System.Data
Imports System.Data.SqlClient
Imports System.Data.Sql
Public Class Form1
Sub PopulateCB()
Dim connection As String = "Data Source=.\SQLEXPRESS;Initial Catalog=OST;Integrated Security=True"
Dim sql = "SELECT * FROM liste_unités"
Dim dt As New DataTable
Using conn As New SqlConnection(connection),
da As New SqlDataAdapter(sql, conn)
da.Fill(dt)
End Using
ComboBoxC1L1.DataSource = dt
ComboBoxC1L1.DisplayMember = "nom_unité"
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
PopulateCB()
End Sub
Private Sub ComboBoxC1L1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBoxC1L1.SelectedIndexChanged
Dim cb = DirectCast(sender, ComboBox)
If cb.SelectedIndex >= 0 Then
Dim val = DirectCast(cb.SelectedItem, DataRowView).Row.Field(Of Integer)("cout_unité")
If ComboBoxQC1L1.Text = "ordinaire" Then
LabelPointsC1L1.Text = val
ElseIf ComboBoxQC1L1.Text = "médiocre" Then
LabelPointsC1L1.Text = val - 2
ElseIf ComboBoxQC1L1.Text = "élite" Then
LabelPointsC1L1.Text = val + 2
End If
If cb.SelectedIndex >= 0 Then
Dim val2 = DirectCast(cb.SelectedItem, DataRowView).Row.Field(Of String)("type_unité")
LabelUnitType.Text = val2
End If
End If
Try
Dim totalC1L1 As Integer
totalC1L1 = CInt(TextBoxC1L1.Text) * CInt(LabelPointsC1L1.Text)
LabelTotalC1L1.Text = totalC1L1
Catch ex As Exception
End Try
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ComboBoxQC1L1.Text = "ordinaire"
End Sub
Private Sub TextBoxC1L1_TextChanged(sender As Object, e As EventArgs) Handles TextBoxC1L1.TextChanged
Try
Dim totalC1L1 As Integer
totalC1L1 = CInt(TextBoxC1L1.Text) * CInt(LabelPointsC1L1.Text)
LabelTotalC1L1.Text = totalC1L1
Catch ex As exception
End Try
End Sub
End Class
Here is the program interface
Here is the SQL table look
Here is the program interface when the Button has been clicked
Red Arrow ComboBox text is a DropDownStyle box with 3 possible text choices:
ordinaire,
élite,
médiocre
What I want to do: when changing the red arrow combobox text, the cout_unité label should change too with a "cout_unité -2" in case of "médiocre" ComboBox text, or "cout_unité +2" in case of "élite" ComboBox text or remain = to "cout_unité" if the selected text is "ordinaire".
And it should calculate this only once from the original "cout_unité" value in the table (in case of clicking 10 times on "ordinaire", it shouldn't subtract 10 * 2 to the "cout_unité" value, only 1 * 2)
I can do it in the ComboBoxC1L1 (see code) but I can't reproduce it with this red arrow combobox (probably because of the type of data into this combobox which are "strings", I don't know).
Many thanks :)
Since there is only a single Handles clause, the following line is unnecessary. The sender can only be the ComboBox in the Handles.
Dim cb = DirectCast(sender, ComboBox)
If you set the ValueMember of the combo in the PopulateCB method, you can save a long line of code making the code more readable.
Dim val = DirectCast(cb.SelectedItem, DataRowView).Row.Field(Of Integer)("cout_unité")
To:
Dim val = CInt(ComboBoxC1L1.SelectedValue)
We need the CInt since SelectedValue is an Object.
Don't assign the DataSource until after the DisplayMember and ValueMember are set.
You are checking twice for ComboBoxC1L1.SelectedIndex >= 0.
Just include the unit type in the first If.
The user may not have to trigger the SelectedIndexChanged event if the correct value is already selected. Maybe a button click would be better.
Sub PopulateCB()
Dim connection As String = "Data Source=.\SQLEXPRESS;Initial Catalog=OST;Integrated Security=True"
Dim sql = "SELECT * FROM liste_unités"
Dim dt As New DataTable
Using conn As New SqlConnection(connection),
da As New SqlDataAdapter(sql, conn)
da.Fill(dt)
End Using
ComboBoxC1L1.DisplayMember = "nom_unité"
ComboBoxC1L1.ValueMember = "cout_unité"
ComboBoxC1L1.DataSource = dt
End Sub
Private Sub btnCalculateValue_Click(sender As Object, e As EventArgs) Handles btnCalculateValue.Click
If ComboBoxC1L1.SelectedIndex >= 0 Then
Dim val = CInt(ComboBoxC1L1.SelectedValue)
If ComboBoxQC1L1.Text = "ordinaire" Then
LabelPointsC1L1.Text = val.ToString
ElseIf ComboBoxQC1L1.Text = "médiocre" Then
LabelPointsC1L1.Text = (val - 2).ToString
ElseIf ComboBoxQC1L1.Text = "élite" Then
LabelPointsC1L1.Text = (val + 2).ToString
End If
Dim val2 = DirectCast(ComboBoxC1L1.SelectedItem, DataRowView).Row.Field(Of String)("type_unité")
LabelUnitType.Text = val2
End If
Dim totalC1L1 As Integer
totalC1L1 = CInt(TextBoxC1L1.Text) * CInt(LabelPointsC1L1.Text)
LabelTotalC1L1.Text = totalC1L1.ToString
End Sub
I'm newbie, I've a XAML file and code behind's, its load all data but I will lazy loading. I binding data in listview. I tried searching but did not produce the expected results, so there is no way that can be done.
code behind:
Public Sub MappingThumbnailSearchResult(thumbSearchResult As VI_ThumbnailSearchResultResponse, token As CancellationToken, ByRef dataDic As Dictionary(Of String, ObservableCollection(Of Object)))
Dim data As List(Of Object) = New List(Of Object)
Try
If thumbSearchResult.result_body Is Nothing OrElse thumbSearchResult.result_body.search_result Is Nothing Then Exit Sub
For Each item In thumbSearchResult.result_body.search_result
Try
If token.IsCancellationRequested Then Exit Sub
Dim thumbnailKey As String = ""
If Not item.thumbnail_key.Contains("\\") Then
thumbnailKey = item.thumbnail_key.ToString().Replace("\", "\\")
Else
thumbnailKey = item.thumbnail_key
End If
Dim imageResult = RequestAPI.GetInstance.GetThumbnailBase64(New VI_ThumbnailRequest With {.ThumbnailKey = thumbnailKey})
Dim hasThumb As Boolean = False
If imageResult IsNot Nothing Then
If imageResult.result_body.thumbnail IsNot Nothing Then
hasThumb = True
Dim base64Str As String = imageResult.result_body.thumbnail
item.thumbnail_base64 = imageResult.result_body.thumbnail
item.thumbnail_bitmap = BaseViewModel.BitmapFromSource(BaseViewModel.Base64ToImage(base64Str))
End If
End If
If Not hasThumb Then
'default image if have error when get thumbnail image
If item.system_type.Equals(EnumType.SystemType.face.ToString()) Then
item.thumbnail_base64 = BaseViewModel.ConvertBitmapToBase64(My.Resources.gender_unknown_2)
item.thumbnail_bitmap = My.Resources.gender_unknown_2
ElseIf item.system_type.Equals(EnumType.SystemType.people.ToString()) Then
item.thumbnail_base64 = BaseViewModel.ConvertBitmapToBase64(My.Resources.People)
item.thumbnail_bitmap = My.Resources.People
End If
End If
Dim tmpDate As DateTime
Dim shotDate As Date
If DateTime.TryParseExact(item.shot_date_time, RESPONSE_DATE_FORMAT2, Nothing, DateTimeStyles.AssumeLocal, tmpDate) Then
shotDate = tmpDate
Else
shotDate = DateTime.Now
End If
Dim dateKey As String = shotDate.ToString(PRIVATE_DATE_FORMAT)
If Not dataDic.ContainsKey(dateKey) Then
Dim thumbList = New ObservableCollection(Of Object)
Dim objThumb As Object = MappingVIThumbnailFromResponse(item, shotDate)
thumbList.Add(objThumb)
dataDic.Add(dateKey, thumbList)
Else
Dim objThumb As Object = MappingVIThumbnailFromResponse(item, shotDate)
dataDic.Item(dateKey).Add(objThumb)
End If
Catch ex As Exception
Dim b As Integer = 0
End Try
Next
Catch ex As Exception
Dim c As Integer = 0
End Try
End Sub
After, I binding data as below
Dim result As ObservableCollection(Of ListViewThumbnailViewModel) = New ObservableCollection(Of ListViewThumbnailViewModel)
If dataDic.Count > 0 Then
If token.IsCancellationRequested Then Return data
For Each pair As KeyValuePair(Of String, ObservableCollection(Of Object)) In dataDic
Dim _date As DateTime = DateTime.ParseExact(pair.Key, PRIVATE_DATE_FORMAT, CultureInfo.InvariantCulture)
result.Add(New ListViewThumbnailViewModel() With {.DateItem = _date, .ListThumbnail = pair.Value})
_viewModel.ResultSearch.TotalData += pair.Value.Count
Next
_viewModel.ResultSearch.ListResult = result
_viewModel.ResultSearch.ListResultActual = result
_viewModel.ResultSearch.PageSize = PageHelper.GetPageSizeWithZoom(_viewModel.ResultSearch.ZoomImage * 10, _viewModel.ResultSearch.PageSizeStart, _viewModel.ResultSearch.NumberChange)
_viewModel.ResultSearch.PageCurrent = 0
_viewModel.ResultSearch.TotalPage = PageHelper.GetTotalPageByPageSize(result.Count, _viewModel.ResultSearch.PageSize)
Else
_viewModel.ResultSearch.ListResult = Nothing
_viewModel.ResultSearch.ListResultActual = Nothing
End If
Catch ex As Exception
Throw New AIMatchingException(ex)
End Try
Return data
What should I do? please help me, thanks!!!
We have a series of ListBoxes - when an item in the main ListBox is selected the relevant values are displayed in the sub ListBox. This works as intended...
We also have the ability to move items up or down, and this works as intended...
When the main ListBox has the SelectionChanged event wired up the ability to move items up and down in the sub list box stops working. Comment that out and up/down works again in the sub ListBox... I must have overlooked something glaringly obvious but after numerous changes still can't get it to work
Main ListBox SelectionChanged
Private Sub Reports_CashFlow_ListBox_IndexChanged(ByVal MainLB As String, ByVal NominalLB As String, ByVal NomDT As DataTable)
Try
Dim LB As LBx = ReportCashFlow_Grid.FindName(MainLB)
If LB.SelectedIndex = -1 Then
Exit Sub
End If
Dim NomLB As LBx = ReportCashFlow_Grid.FindName(NominalLB)
If NomLB Is Nothing Then
Exit Sub
End If
If LB.SelectedValue Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name <> "DataRowView" Then
Dim CatID As Integer = LB.SelectedValue
Dim DV As New DataView(NomDT)
DV.RowFilter = "CatID = " & CatID & " AND FormID = " & Form_ID
DV.Sort = "Position"
With NomLB
.ItemsSource = DV
.Items.Refresh()
End With
LB.ScrollIntoView(LB.SelectedItem)
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Move items up
Private Sub Reports_BalanceSheet_ListBoxMoveUp(LB As ListBox, DT As DataTable, DisplayName As String, Optional MasterListBox As ListBox = Nothing)
Try
Dim StartIndex As Integer = LB.SelectedIndex
If StartIndex = -1 Then
AppBoxValidation("You have not selected an item to move up!")
Exit Sub
End If
If Not StartIndex = 0 Then
Dim CatID As Integer = 0
If DisplayName = "NomName" Then
CatID = MasterListBox.SelectedValue
End If
Dim vSelected As DataRow = DT.Rows(StartIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, StartIndex - 1)
DT.AcceptChanges()
LB.SelectedIndex = StartIndex - 1
Dim vPos As Integer = 0
For Each Row As DataRow In DT.Rows
If Not CatID = 0 Then
If Row("CatID") = CatID Then
Row("Position") = vPos
vPos += 1
End If
Else
Row("Position") = vPos
vPos += 1
End If
Next
LB.Items.Refresh()
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Turns out the issue related to subsets of data in the DataView - so needed to find the correct index for the selected item and the replacement index in the entire back-end table
Private Sub Reports_BalanceSheet_ListBoxMoveUp(LB As ListBox, DT As DataTable, DisplayName As String, Optional MasterListBox As ListBox = Nothing)
Try
Dim StartIndex As Integer = LB.SelectedIndex
If StartIndex = -1 Then
AppBoxValidation("You have not selected an item to move up!")
Exit Sub
End If
If Not StartIndex = 0 Then
Dim CatID As Integer = 0
If DisplayName = "NomName" Then
CatID = MasterListBox.SelectedValue
'As the view could be a subset of data we need to find the actual back end DB index
Dim SelectedID As Integer = LB.SelectedValue
Dim DR() As DataRow = DT.Select("ID = " & SelectedID, Nothing)
Dim vIndex As Integer = DT.Rows.IndexOf(DR(0))
Dim vCurrentPos As Integer = DR(0)("Position")
'Find the index of the one above in the grid
Dim DR2() As DataRow = DT.Select("CatID = " & CatID & " AND Position = " & vCurrentPos - 1, Nothing)
Dim vIndex2 As Integer = DT.Rows.IndexOf(DR2(0))
Dim vSelected As DataRow = DT.Rows(vIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, vIndex2)
DT.AcceptChanges()
Else
Dim vSelected As DataRow = DT.Rows(StartIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, StartIndex - 1)
DT.AcceptChanges()
End If
Dim vPos As Integer = 0
For Each Row As DataRow In DT.Rows
If Not CatID = 0 Then
If Row("CatID") = CatID Then
Row("Position") = vPos
vPos += 1
End If
Else
Row("Position") = vPos
vPos += 1
End If
Next
LB.SelectedIndex = StartIndex - 1
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
I have a ListBox populated by a DataTable - adding items, moving items all work but delete doesn't - it reflects in the DataTable but clears all items from the ListBox unless it is reloaded as part of a SelectionChanged event.
I have tried Listbox.Items.Refresh and setting the ItemsSource to Nothing and re-assigning back to the DataTable.
Any ideas?
Thanks
Private Sub Reports_BalanceSheet_NominalListBox_Delete(NomLB As String, DT As DataTable)
Try
Dim LB As ListBox = Reports_BalanceSheet_Grid.FindName(NomLB)
If LB.SelectedIndex = -1 Then
AppBoxValidation("No item has been selected for deletion!")
Exit Sub
End If
Dim FR() As DataRow = DT.Select("ID = " & LB.SelectedValue, Nothing)
Dim CatID As Integer = 0
For Each row As DataRow In FR
CatID = row("CatID")
row.Delete()
Next
DT.AcceptChanges()
Dim vDV As New DataView(DT)
vDV.RowFilter = "FormID = " & FormID & " AND CatID = " & CatID
vDV.Sort = "Position"
DT = vDV.ToTable
vDV = Nothing
Dim i As Integer = 0
For Each row As DataRow In DT.Rows
row("Position") = i
i += 1
Next
With LB
.ItemsSource = DT.DefaultView
.DisplayMemberPath = "Name"
.SelectedValuePath = "ID"
End With
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Turns out the clue was 'unless it is reloaded as part of the SelectionChanged event'
added this to the end and it all works perfectly :-)
Have you ever noticed that you can spend hours going round in circles and the moment you post the problem you figure it out?
Dim MainLB As String = NomLB.Replace("Nominal", "")
Reports_BalanceSheet_ListBox_IndexChanged(MainLB, NomLB, DT)
and that runs
Private Sub Reports_BalanceSheet_ListBox_IndexChanged(ByVal MainLB As String, ByVal NominalLB As String, ByVal NomDT As DataTable)
Try
Dim LB As ListBox = Reports_BalanceSheet_Grid.FindName(MainLB)
If LB.SelectedIndex = -1 Then
Exit Sub
End If
Dim NomLB As ListBox = Reports_BalanceSheet_Grid.FindName(NominalLB)
If NomLB Is Nothing Then
Exit Sub
End If
If LB.SelectedValue Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name <> "DataRowView" Then
Dim CatID As Integer = LB.SelectedValue
Dim DT As DataTable = NomDT.Copy()
Dim vDV As New DataView(DT)
vDV.RowFilter = "CatID = " & CatID & " AND FormID = " & FormID
vDV.Sort = "Position"
DT = vDV.ToTable
vDV = Nothing
With NomLB
.ItemsSource = DT.DefaultView
.SelectedValuePath = "ID"
.DisplayMemberPath = "NomName"
.Items.Refresh()
End With
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
This one has driven me nuts for long enough.
Start a background thread to download data from a webservice on a new thread then show an image on the status bar and change the text.
I have tried with Dispatcher (with each priority) but nothing happens until the threaded sub completes. The closest I can get is implementing the equivalent of DoEvents that at least loads the image and the text, but then the image stops spinning until the thread completes.
Any ideas?
Public Sub Return_DT(ByVal TableName As String)
CurrentDT = TableName
If DownloadingDS Is Nothing Then
DownloadingDS = New Dictionary(Of String, String)
End If
If DownloadingDS.ContainsKey(TableName) = False Then
DownloadingDS.Add(TableName, "Loading")
Else
Exit Sub
End If
Select Case TableName
Case "A_Documents"
strSQL = "SELECT Document_ID, Account_Type, Account_No, Document_Description, Accounts_Only, Open_Editing, Editing_Name, Updated_Name, Updated FROM A_Documents"
Case Else
strSQL = "SELECT * FROM " & TableName
End Select
' Dispatcher.CurrentDispatcher.BeginInvoke(DispatcherPriority.Background, CType(Sub() LoadMetroImage(), SendOrPostCallback), Nothing)
'Dispatcher.CurrentDispatcher.BeginInvoke(DispatcherPriority.Background, CType(Sub() ChangeLeftStatusText("Downloading " & CurrentDT & " data..."), SendOrPostCallback), Nothing)
LoadMetroImage()
ChangeLeftStatusText("Downloading " & CurrentDT & " data...")
Application.Current.MainWindow.FindName("MainMetroStatusBar")
Dim vWorker As New BackgroundWorker
AddHandler vWorker.DoWork, AddressOf BackgroundDownload
AddHandler vWorker.RunWorkerCompleted, AddressOf DownloadCompleted
vWorker.RunWorkerAsync()
DoEvents()
End Sub
This is the closest I can get
Public Sub DoEvents()
Dim frame As New DispatcherFrame()
Dispatcher.CurrentDispatcher.BeginInvoke(DispatcherPriority.Background, New DispatcherOperationCallback(AddressOf ExitFrame), frame)
Dispatcher.PushFrame(frame)
End Sub
Public Function ExitFrame(ByVal f As Object) As Object
CType(f, DispatcherFrame).Continue = False
Return Nothing
End Function
=== EDIT === How Return_DT is called
Public Function DT_Return(ByVal DT As DataTable, ByVal TableName As String) As DataTable
Try
If Not DT Is Nothing Then
If DT_CheckUpdated(TableName) = True Then
Return DT
Else
Return_DT(TableName)
vService = New Service1Client
Dim DS As DataSet = vService.ReturnDataSet("SELECT * FROM " & TableName, Current_HOA_ID)
Dim vDT As DataTable = DS.Tables(0).Copy
DS.Dispose()
Return vDT
End If
Else
Return_DT(TableName)
vService = New Service1Client
Dim DS As DataSet = vService.ReturnDataSet("SELECT * FROM " & TableName, Current_HOA_ID)
Dim vDT As DataTable = DS.Tables(0).Copy
DS.Dispose()
Return vDT
End If
Catch ex As Exception
EmailError(ex)
Return Nothing
End Try
End Function
I found the solution was to use Dispatcher.Timer in the UI thread to check every second to see if the DT had been downloaded..
Public Function DT_Return(ByVal DT As DataTable, ByVal TableName As String) As DataTable
Try
If Not DT Is Nothing Then
If DT_CheckUpdated(TableName) = True Then
Return DT
Else
CurrentlyDownloading = True
Return_DT(TableName)
Dim vTimer As New DispatcherTimer
vTimer.Interval = TimeSpan.FromMilliseconds(1000)
AddHandler vTimer.Tick, Sub(sender As Object, e As EventArgs)
Do While CurrentlyDownloading = True
Loop
vTimer.Stop()
End Sub
vTimer.Start()
Return DT
End If
Else
CurrentlyDownloading = True
Return_DT(TableName)
Dim vTimer As New DispatcherTimer
vTimer.Interval = TimeSpan.FromMilliseconds(1000)
AddHandler vTimer.Tick, Sub(sender As Object, e As EventArgs)
Do While CurrentlyDownloading = True
Loop
vTimer.Stop()
End Sub
vTimer.Start()
Return DT
End If
Catch ex As Exception
EmailError(ex)
Return Nothing
End Try
End Function