WPF Move Caret position after inserting list - wpf

I am inserting lists into a RichTextBox like this - but how do I get the Caret to move to the first list item?
Private Sub TextEditor_BulletListAdd(sender As Object, e As RoutedEventArgs)
Try
Dim vEditor As RichTextBox = TextEditorGrid.FindName("Controls_TextEditorRTF")
Dim vList As New List()
vList.MarkerStyle = TextMarkerStyle.Disc
Dim vRun As New Run()
Dim vItem As New ListItem(New Paragraph(vRun))
vList.ListItems.Add(vItem)
Dim curCaret = vEditor.CaretPosition
Dim curBlock = vEditor.Document.Blocks.Where(Function(x) x.ContentStart.CompareTo(curCaret) = -1 AndAlso x.ContentEnd.CompareTo(curCaret) = 1).FirstOrDefault()
vEditor.Document.Blocks.InsertAfter(curBlock, vList)
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Private Sub TextEditor_NumberListAdd(sender As Object, e As RoutedEventArgs)
Try
Dim vEditor As RichTextBox = TextEditorGrid.FindName("Controls_TextEditorRTF")
Dim vList As New List()
vList.MarkerStyle = TextMarkerStyle.Decimal
Dim vRun As New Run()
Dim vItem As New ListItem(New Paragraph(vRun))
vList.ListItems.Add(vItem)
Dim curCaret = vEditor.CaretPosition
Dim curBlock = vEditor.Document.Blocks.Where(Function(x) x.ContentStart.CompareTo(curCaret) = -1 AndAlso x.ContentEnd.CompareTo(curCaret) = 1).FirstOrDefault()
vEditor.Document.Blocks.InsertAfter(curBlock, vList)
Catch ex As Exception
EmailError(ex)
End Try
End Sub

The easy part is setting the position of the caret... the tricky part is finding the pointer of the place that you want to set it to (unless that is simply the beginning or end of the document):
RichTextBox rtb = new RichTextBox(flowDoc);
// Get the current caret position.
TextPointer caretPos = rtb.CaretPosition;
// Set the TextPointer to the end of the current document.
caretPos = caretPos.DocumentEnd; // <<< You need to find the correct position here
// Specify the new caret position at the end of the current document.
rtb.CaretPosition = caretPos;
From RichTextBox.CaretPosition Property on MSDN.

Turns out the answer was a lot simpler that I thought :-)
Dim vMove As TextPointer = curCaret.GetNextInsertionPosition(LogicalDirection.Forward)
If Not vMove Is Nothing Then
vEditor.CaretPosition = vMove
End If
Complete
Private Sub TextEditor_BulletListAdd(sender As Object, e As RoutedEventArgs)
Try
Dim vEditor As RichTextBox = TextEditorGrid.FindName("Controls_TextEditorRTF")
Dim vList As New List()
vList.MarkerStyle = TextMarkerStyle.Disc
Dim vRun As New Run()
Dim vItem As New ListItem(New Paragraph(vRun))
vList.ListItems.Add(vItem)
Dim curCaret = vEditor.CaretPosition
Dim curBlock = vEditor.Document.Blocks.Where(Function(x) x.ContentStart.CompareTo(curCaret) = -1 AndAlso x.ContentEnd.CompareTo(curCaret) = 1).FirstOrDefault()
vEditor.Document.Blocks.InsertAfter(curBlock, vList)
Dim vMove As TextPointer = curCaret.GetNextInsertionPosition(LogicalDirection.Forward)
If Not vMove Is Nothing Then
vEditor.CaretPosition = vMove
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub

Related

VB.NET add or subtract an integer value to a SQL Server value into a label when selecting a combobox item

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

How to implement lazy loading in listview wpf VB.net

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!!!

NotifyCollectionChangedAction.Reset Empties ComboBox Text

I have a ComboBox, which its ItemsSource is set to an object which inherits ObservableCollection.
The object gets refreshed with new data on a timer.
Since sometimes there is a large set of new data, I don't use the Add method on the ObservableCollection, but rather I use the following code:
For Each itm In MyNewItems
Items.Add(itm)
Next
MyBase.OnPropertyChanged(New PropertyChangedEventArgs("Count"))
OnPropertyChanged(New PropertyChangedEventArgs("Items[]"))
'NEXT LINE CAUSES ISSUE
OnCollectionChanged(New NotifyCollectionChangedEventArgs(NotifyCollectionChangedAction.Reset))
The problem is that when the last line runs, the Text of the ComboBox gets reset to an empty string.
If I remove that line, then the issue is resolved, but the Items show old data, since the ComboBox doesn't know that new data came in
Please advise
With appreciation
UPDATE
Hi, as requested, I'm posting the relevant code here
1: The Xaml, Pretty Simple:
<Window x:Class="dlgTest"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:mch="clr-namespace:Machshevet.Windows;assembly=Machshevet" >
<StackPanel>
<TextBlock Text="{Binding CaseID}"/>
<mch:TestPick Name="cmbTest" SelectedValuePath="ID" DisplayMemberPath="Name" SelectedValue="{Binding CaseID}" IsEditable="True" IsTextSearchEnabled="False" />
</StackPanel>
</Window>
2: The TestPick class, not too complex either:
Public Class TestPick
Inherits ComboBox
Dim usertyped As Boolean
Function Query() As IQueryable
Dim txt = ""
Dispatcher.Invoke(Sub() txt = Text)
Dim ret = GetSlimContext.Query("viwCase").Select("new (ID,Name,ClientName,SubjectName)")
If txt <> "" AndAlso usertyped Then ret = ret.TextFiltered(txt)
Return ret
End Function
Private Sub EntityPick_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Dim qs = New QuerySource(Function() Query())
Me.ItemsSource = qs
qs.Control = Me
qs.ShouldRefresh = Function() True
End Sub
Private Sub EntityPick_PreviewTextInput(sender As Object, e As TextCompositionEventArgs) Handles Me.PreviewTextInput
usertyped = True
End Sub
Private Sub TestPick_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles Me.SelectionChanged
If e.AddedItems.None Then
Dim a = 1
End If
End Sub
End Class
3: The QuerySource class which does all the heavy lifting
Public Class QuerySource
Inherits ObjectModel.ObservableCollection(Of Object)
Event Refreshed(sender As QuerySource, e As EventArgs)
Property RefreshSpan As TimeSpan = TimeSpan.FromSeconds(3)
Property CheckProperties As Boolean = True
Property Control As ItemsControl
Dim Timer As Threading.Timer = New Threading.Timer(Sub() TimerTick(), Nothing, 0, 600)
Dim _lastRefresh As Date?
Dim Query As Func(Of IQueryable)
Dim workingon As Date?
Sub New(Query As Func(Of IQueryable), Control As ItemsControl)
Me.Control = Control
Me.Query = Query
End Sub
Async Sub TimerTick()
Try
If Now - _lastRefresh.GetValueOrDefault < RefreshSpan Then Exit Sub
If GetLastInputTime() > 60 * 15 Then Exit Sub
Dim isvis = False
Await Control.Dispatcher.BeginInvoke(Sub() isvis = Control.IsUserVisible())
If Not isvis Then Exit Sub
If workingon.HasValue AndAlso workingon.Value > Now.AddSeconds(-15) Then Exit Sub 'if wasnt working for 15 seconds, probaly err or something
workingon = Now
Dim fq = Query.Invoke
Dim itmtype = fq.ElementType
Dim props = itmtype.CachedProperties.Where(Function(x) x.CanWrite AndAlso x.IsScalar(True)).ToList
Dim keyprops = itmtype.CachedKeyProperties.ToList
Dim newData = fq.ToObjectList
If newData Is Nothing Then Exit Sub
Dim keySelector As Func(Of Object, Object)
Dim diff As CollectionDiff(Of Object)
If itmtype.IsScalar Then 'list of strings..
keySelector = Function(x) x
Else
If keyprops.Count <> 1 Then DevError("?")
Dim kp = keyprops.FirstOrDefault
keySelector = Function(x) kp.GetValue(x)
End If
diff = CollectionDiff(Me, newData, keySelector, props, CheckProperties)
Dim toPreserve As Object
ExecIfType(Of Primitives.Selector)(Control, Sub(x) toPreserve = x.Dispatcher.Invoke(Function() x.SelectedItem))
If toPreserve IsNot Nothing Then diff.ToPreserve = {toPreserve}.ToDictionary(Function(x) x, Function(x) Nothing)
diff.PreserveOnDelete = True
If diff.ModificationCount > 400 Or diff.ClearOld Then
CheckReentrancy()
If diff.ClearOld Then
Items.Clear()
Else
For Each pair In diff.ToReplaceByIndex
Control.Dispatcher.Invoke(Sub() Items(pair.Key) = pair.Value)
Next
For Each idx In diff.GetIndexesToDelete
Items.RemoveAt(idx)
Next
End If
For Each itm In diff.ToAdd 'for mem optimization im not using addrange
Items.Add(itm)
Next
MyBase.OnPropertyChanged(New PropertyChangedEventArgs("Count"))
OnPropertyChanged(New PropertyChangedEventArgs("Items[]"))
Control.Dispatcher.Invoke(Sub() OnCollectionChanged(New NotifyCollectionChangedEventArgs(NotifyCollectionChangedAction.Reset)))
Else
Dim preservIdx = diff.ToPreserve?.Select(Function(x) Items.IndexOf(x.Key))?.ToHashSet
For Each pair In diff.ToReplaceByIndex
Control.Dispatcher.Invoke(Sub() Me(pair.Key) = pair.Value)
Next
For Each idx In diff.GetIndexesToDelete
If diff.PreserveOnDelete AndAlso preservIdx IsNot Nothing AndAlso preservIdx.Contains(idx) Then Continue For
Control.Dispatcher.Invoke(Sub() RemoveAt(idx))
Next
'don't use addrange - will cause a reset
Await Control.Dispatcher.BeginInvoke(Sub() diff.ToAdd.ForEach(Sub(x) Add(x)))
End If
_lastRefresh = Now
workingon = Nothing
Control.Dispatcher.Invoke(Sub()
Dim cvs = System.Windows.Data.CollectionViewSource.GetDefaultView(Me)
If cvs.SortDescriptions.None Then
Dim defsorts = {KVP("Name", False), KVP(NameOf(RecordBase.LastEditedOn), True), KVP(NameOf(LiteRecordBase.ID), True)}
For Each defsort In defsorts
If itmtype.HasProperty(defsort.Key) Then
cvs.SortDescriptions.Add(New SortDescription(defsort.Key, If(defsort.Value, ListSortDirection.Descending, ListSortDirection.Ascending)))
Exit For
End If
Next
End If
End Sub)
RaiseEvent Refreshed(Me, Nothing)
Catch ex As Exception
Control.Dispatcher.BeginInvoke(Sub() ex.Rethrow)
End Try
End Sub
End Class
Okay
Thanks all for chipping in, in the end it seems like my answer is actually here
ObservableCollection : calling OnCollectionChanged with multiple new items
Works like a charm, and thank you all again for your time and patience

WPF - destroy page after unloaded has run

In a WPF app we have the need to sometimes create a new tab that contains a Page inside a Frame..
Once the page has been opened (initialised once) it still seems to stay in navigation history and attempts to load data that may not be relevant at the time.
I have tried a myriad of methods including NavigationService.RemoveBackEntry, but it still persists :-(
This is an example of how the tab/page are opened
Private Sub CashFlow_Edit(sender As Object, e As RoutedEventArgs)
Try
Dim DGV As DGVx = ReportsCashFlow_Grid.FindName("CashFlow_DGV")
e.Handled = True
IsNewRecord = False
If DGV.SelectedItems.Count = 1 Then
Dim row As System.Data.DataRowView = DGV.SelectedItems(0)
Form_ID = row("ID")
Dim vName As String = row("Name")
Dim vTab As STC_Tabx = Application.Current.MainWindow.FindName(TabName)
Dim TabControl As STCx = Application.Current.MainWindow.FindName("AccountingReports_TabControl")
If Not vTab Is Nothing Then
vTab.Close()
End If
Dim MCFrame As New Frame
Dim MCTab As New STC_Tabx
With MCTab
.Name = TabName
.Header = " " & vName & " "
.ImageSource = ReturnImageAsString("Edit.png", 16)
.CloseButtonVisibility = DevComponents.WpfEditors.eTabCloseButtonVisibility.Visible
.TabToolTip = "View or edit the " & vName & " template"
.Content = MCFrame
End With
RemoveHandler MCTab.Closing, AddressOf TabControl_TabClosing
AddHandler MCTab.Closing, AddressOf TabControl_TabClosing
Dim vGrid As Grid = Application.Current.MainWindow.FindName("MainGrid_Accounting")
RegisterControl(vGrid, MCTab)
TabControl.Items.Add(MCTab)
Dim MCPage As New ReportCashFlow_Page
MCFrame.NavigationService.Navigate(MCPage)
LoadedTabs(TabName)
MCTab.IsSelected = True
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
To remove all the back entries do something like:
while(NavigationService.CanGoBack)
{
NavigationService.RemoveBackEntry();
}
It's not the clean bit of code I would like, but it works - create a global Boolean - when the sub that opens the tab/page is called it's set to true and the loading event will only run the loading code if this is true - it's set to false at the end.
Private Sub ReportCashFlow_Page_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Try
If IsNewTab = False Then
Exit Sub
End If
'Run all the loading code here
Catch ex As Exception
EmailError(ex)
Finally
IsNewTab = False
Dispatcher.CurrentDispatcher.BeginInvoke(DispatcherPriority.Background, CType(Sub() CashFlow_LoadBudget(), SendOrPostCallback), Nothing)
Dispatcher.CurrentDispatcher.BeginInvoke(DispatcherPriority.Background, CType(Sub() ToggleReserve(), SendOrPostCallback), Nothing)
End Try
End Sub

WebClient error with Arrays VB.NET

I'm using and array of files to be copied from a folder to another folder but it gives me an error.WebClient does not support concurrent I/O operations.
this is my code:
Protected Overrides Sub OnLoad(e As EventArgs)
MyBase.OnLoad(e)
CopyBtn.Text = "Copy File"
CopyBtn.Parent = Me
ProgBar.Left = CopyBtn.Right
End Sub
Dim WithEvents CopyBtn As New Button
Dim ProgBar As New ProgressBar
Dim WithEvents FileCopier As New WebClient
Private Sub CopyBtn_Click(sender As Object, e As EventArgs) Handles CopyBtn.Click
Dim src As String = "D:\test"
Dim dest As String = "D:\test2"
Dim filesToCopy As New ArrayList()
For Each Dir As String In System.IO.Directory.GetFiles(src)
Dim dirInfo As New System.IO.DirectoryInfo(Dir)
If Not System.IO.File.Exists(dest & "\" & dirInfo.Name) Then
filesToCopy.Add(dirInfo.Name)
End If
Next
If filesToCopy.Count > 0 Then
If MsgBox("There are new files found. Do you want to sync it now?", MsgBoxStyle.Question + MsgBoxStyle.YesNo, "Confirm") = MsgBoxResult.Yes Then
For i = 0 To filesToCopy.Count - 1
CopyBtn.Enabled = False
ProgBar.Parent = Me
FileCopier.DownloadFileAsync(New Uri(src & "\" & filesToCopy(i)), dest & "\" & filesToCopy(i))
Next
End If
Else
MsgBox("No new files to be copied")
End If
End Sub
Private Sub FileCopier_DownloadProgressChanged(sender As Object, e As DownloadProgressChangedEventArgs) Handles FileCopier.DownloadProgressChanged
Dim bytesIn As Double = Double.Parse(e.BytesReceived.ToString())
Dim totalBytes As Double = Double.Parse(e.TotalBytesToReceive.ToString())
Dim percentage As Double = bytesIn / totalBytes * 100
ProgBar.Value = Int32.Parse(Math.Truncate(percentage).ToString())
End Sub
Private Sub FileCopier_DownloadFileCompleted(sender As Object, e As System.ComponentModel.AsyncCompletedEventArgs) Handles FileCopier.DownloadFileCompleted
ProgBar.Parent = Nothing
CopyBtn.Enabled = True
End Sub
but when i put this code before the copying/downloadfileasync
Dim FileCopier as WebClient = New Webclient
it successfully copies. but the progressbar is not working,even if i put this onDownloadProgressChangedProgBar.Value = e.ProgressPercentage it doesn't load. can you please help me? Just a newbie still learning here.
wew, i just needed to add this
AddHandler FileCopier.DownloadProgressChanged, AddressOf FileCopier_DownloadProgressChanged
AddHandler FileCopier.DownloadFileCompleted, AddressOf FileCopier_DownloadFileCompleted
with this codes:Dim FileCopier as WebClient = New Webclient
ProgBar.Value = e.ProgressPercentage

Resources