I am not sure if anyone can help with this, but I inhertied this code and I have no idea what the issue is nor am I familiar with the WndProc method. The area that is not running is the "' check for custom draw message" section. I need it to run the ProcessListCustomDraw(m) method so some thumbnails are generated. I beleive the origianl application was wirtten for .Net 1.1, so I may be SOL. Any ideas or thoughts would be greatly appreciated.
<SecurityPermission(SecurityAction.LinkDemand, Flags:=SecurityPermissionFlag.UnmanagedCode)> _
Protected Overrides Sub WndProc(ByRef m As Message)
Try
If m.Msg = Win32.Consts.WM_NCPAINT Then
' always repaint background if get wm_ncpaint
_backgroundDirty = True
End If
If m.Msg = Win32.Consts.WM_ERASEBKGND Then
' see if should repaint the background or not
If ProcessBackground() = False Then Return
End If
' look for messages to owner draw the listview items
If m.Msg = Win32.Consts.OCM_NOTIFY Then
' get the notification info
Dim notifyHeader As Win32.NMHDR = _
CType(m.GetLParam(GetType(Win32.NMHDR)), Win32.NMHDR)
' turn off background painting when get the item changed message
If notifyHeader.code = Win32.Consts.LVN_ITEMCHANGED Then
_paintBackground = False
End If
' check for custom draw message
If notifyHeader.hwndFrom.Equals(Me.Handle) And _
notifyHeader.code = Win32.Consts.NM_CUSTOMDRAW Then
_paintBackground = True
' process the message, returns true if performed custom
' drawing, otherwise false
If ProcessListCustomDraw(m) Then
Return
End If
End If
End If
MyBase.WndProc(m)
Catch ex As Exception
Log.WriteLog(Log.SZ_LOG_EXCEPTION & MethodBase.GetCurrentMethod().Name & " " & ex.Message)
End Try
End Sub
' one step closer to detecting if a listview item should be drawn
' return true if the listview item was drawn
Private Function ProcessListCustomDraw(ByRef m As Message) As Boolean
Try
' return true if performed custom drawing
Dim drawSelf As Boolean = False
' get custom draw information
Dim customDraw As Win32.NMCUSTOMDRAW = _
CType(m.GetLParam(GetType(Win32.NMCUSTOMDRAW)), Win32.NMCUSTOMDRAW)
' return different values in the message depending on the draw stage
Select Case customDraw.dwDrawStage
Case Win32.Consts.CDDS_PREPAINT
m.Result = New System.IntPtr(Win32.Consts.CDRF_NOTIFYITEMDRAW)
Case Win32.Consts.CDDS_ITEMPREPAINT
m.Result = New System.IntPtr(Win32.Consts.CDRF_SKIPDEFAULT)
If IsItemVisible(customDraw.dwItemSpec) Then
' finally, draw the listview item
Dim g As Graphics = Graphics.FromHdc(customDraw.hdc)
Try
DrawItemEg(g, CInt(customDraw.dwItemSpec))
drawSelf = True
Finally
g.Dispose()
End Try
Else
drawSelf = True
End If
Case Else
m.Result = New System.IntPtr(Win32.Consts.CDRF_DODEFAULT)
End Select
Return drawSelf
Catch ex As Exception
Log.WriteLog(Log.SZ_LOG_EXCEPTION & MethodBase.GetCurrentMethod().Name & " " & ex.Message)
End Try
End Function
Update: Here is the Win32 Class:
' win32 values
Private Class Win32
Public Enum Consts
' messages
WM_NCPAINT = &H85
WM_ERASEBKGND = &H14
WM_NOTIFY = &H4E
OCM_BASE = &H2000
OCM_NOTIFY = OCM_BASE + WM_NOTIFY
NM_CUSTOMDRAW = -12
NM_SETFOCUS = -7
LVN_ITEMCHANGED = -101
' custom draw return flags
CDRF_DODEFAULT = &H0
CDRF_SKIPDEFAULT = &H4
CDRF_NOTIFYITEMDRAW = &H20
' custom draw state flags
CDDS_PREPAINT = &H1
CDDS_ITEM = &H10000
CDDS_ITEMPREPAINT = CDDS_ITEM Or CDDS_PREPAINT
End Enum
<StructLayout(LayoutKind.Sequential)> _
Public Structure NMHDR
Public hwndFrom As IntPtr
Public idFrom As Integer
Public code As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure NMCUSTOMDRAW
Public hdr As NMHDR
Public dwDrawStage As Integer
Public hdc As IntPtr
Public rc As RECT
Public dwItemSpec As Integer
Public uItemState As Integer
Public lItemlParam As IntPtr
End Structure
End Class
If it works on x86 then your P/Invoke declarations are probably wrong. Using Integer where IntPtr is required, something like that. You didn't post them, I can't tell. Visit pinvoke.net to get the right ones.
After seeing your edit: yes, your NMHDR declaration is wrong. It must look like this:
<StructLayout(LayoutKind.Sequential)> _
Public Structure NMHDR
Public hwndFrom As IntPtr
Public idFrom As IntPtr ' NOT INTEGER!!!
Public code As Integer
End Structure
Related
I have to make a application that organizes a list of runners and their teams. In the following text file, I have to remove the top half of the text file (the top half being the listed teams) and display only the bottom half (the runners)in a listbox item.
The Text file:
# School [School Code|School Name|Coach F-Name|Coach L-Name|AD F-Name|AD L Name]
WSHS|Worcester South High School|Glenn|Clauss|Bret|Zane
WDHS|Worcester Dorehty High School|Ellsworth|Quackenbush|Bert|Coco
WBCHS|Worcester Burncoat High School|Gail|Cain|Kevin|Kane
QRHS|Quabbin Regional High School|Bob|Desilets|Seth|Desilets
GHS|Gardner High School|Jack|Smith|George|Fanning
NBHS|North Brookfield High School|Hughe|Fitch|Richard|Carey
WHS|Winchendon High School|Bill|Nice|Sam|Adams
AUBHS|Auburn High School|Katie|Right|Alice|Wonderland
OXHS|Oxford High School|Mary|Cousin|Frank|Daughter
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
101|WSHS|Sanora|Hibshman
102|WSHS|Bridgette|Moffitt
103|WSHS|Karine|Chunn
104|WSHS|Shanita|Wind
105|WSHS|Fernanda|Parsell
106|WSHS|Albertha|Baringer
107|WSHS|Carlee|Sowards
108|WDHS|Maisha|Kleis
109|WDHS|Lezlie|Berson
110|WDHS|Deane|Rocheleau
111|WDHS|Hang|Hodapp
112|WDHS|Zola|Dorrough
113|WDHS|Shalon|Mcmonigle
I have some code that reads each row from the text file as an array and uses boolean variables to determine where to end the text file. This worked with displaying only the teams, which I've managed to do. But I now need to do the opposite and display only the players, and I'm a bit stumped.
My Code:
Private Sub btnLoadTeams_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoadTeam.Click
' This routine loads the lstTeam box from an ASCII .txt file
' # School [School Code | Name | Coach F-Name| Coach L-Name | AD F-Name | AD L-Name]
Dim strRow As String
Dim bolFoundCode As Boolean = False
Dim bolEndCode As Boolean = False
Dim bolFoundDup As Boolean = False
Dim intPosition As Integer
Dim intPosition2 As Integer
Dim strTeamCodeIn As String
Dim textIn As New StreamReader( _
New FileStream(txtFilePath.Text, FileMode.OpenOrCreate, FileAccess.Read))
' Clear Team listbox
lstTeam.Items.Clear()
btnDeleteRunner.Enabled = True
Do While textIn.Peek <> -1 And Not bolEndCode
Me.Refresh()
strRow = textIn.ReadLine.Trim
If Not bolFoundCode Then
If "# SCHOOL " = UCase(Mid(strRow, 1, 9)) Then
bolFoundCode = True
End If
Else
If Mid(strRow, 1, 2) <> "# " Then
For Each item As String In lstTeam.Items
intPosition = InStr(1, strRow, "|")
strTeamCodeIn = Mid(strRow, 1, intPosition - 1)
intPosition2 = InStr(1, item, strTeamCodeIn)
If intPosition2 > 0 Then
bolFoundDup = True
MsgBox("Found Duplicate School Code: " & strTeamCodeIn)
End If
Else
bolEndCode = True
Next
If Not bolFoundDup Then
lstTeam.Items.Add(strRow)
Else
lstTeam.Items.Add("DUPLICATE School Code: " & strRow)
lstTeam.Items.Add("Please correct input file and reload teams")
bolEndCode = True
End If
End If
End If
Loop
End Sub
Ive put bolEndCode = True in between the part that reads the mid section of the text file, but all Ive managed to display is the following in the listbox:
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
Any help or hints on how I would display just the runners to my "lstPlayers" listbox would be greatly appreciated. I'm a beginner programmer and We've only just started learning about reading and writing arrays in my .NET class.
First I made 2 classes, one Runner and one School. These have the properties available in the text file. As part of the class I added a function that overrides .ToString. This is for he list boxes that call .ToString for display.
Next I made a function that reads all the data in the file. This is very simple with the File.ReadLines method.
Then I created 2 variables List(Of T) T stands for Type. Ours Types are Runner and School. I used List(Of T) instead of arrays because I don't have to worry about what the size of the list is. No ReDim Preserve, just keep adding items. The FillList method adds the data to the lists. First I had to find where the schools ended and the runners started. I used the Array.FindIndex method which is a bit different because the second parameter is a predicate. Check it out a bit. Now we know the indexes of the lines we want to use for each list and use a For...Next loop. In each loop an instance of the class is created and the properties set. Finally the new object is added to the the list.
Finally we fill the list boxes with a simple .AddRange and the lists.ToArray. Note that we are adding the entire object, properties and all. The neat thing is we can access the properties from the listbox items. Check out the SelectedIndexChanged event. You can do the same thing with the Runner list box.
Sorry, I couldn't just work with your code. I have all but forgotten the old vb6 methods. InStr, Mid etc. It is better when you can to use .net methods. It makes your code more portable when the boss says "Rewrite the whole application in C#"
Public Class Runner
Public Property BibNum As Integer
Public Property SchoolCode As String
Public Property FirstName As String
Public Property LastName As String
Public Overrides Function ToString() As String
'The listbox will call .ToString when we add a Runner object to determin what to display
Return $"{FirstName} {LastName}" 'or $"{LastName}, {FirstName}"
End Function
End Class
Public Class School
Public Property Code As String
Public Property Name As String
Public Property CoachFName As String
Public Property CoachLName As String
Public Property ADFName As String
Public Property ADLName As String
'The listbox will call .ToString when we add a School object to determin what to display
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Private Runners As New List(Of Runner)
Private Schools As New List(Of School)
Private Function ReadData(path As String) As String()
Dim lines = File.ReadLines(path).ToArray
Return lines
End Function
Private Sub FillLists(data As String())
Dim location = Array.FindIndex(data, AddressOf FindRosterLine)
'The first line is the title so we don't start at zero
For index = 1 To location - 1
Dim SplitData = data(index).Split("|"c)
Dim Schl As New School
Schl.Code = SplitData(0)
Schl.Name = SplitData(1)
Schl.CoachFName = SplitData(2)
Schl.CoachLName = SplitData(3)
Schl.ADFName = SplitData(4)
Schl.ADLName = SplitData(5)
Schools.Add(Schl)
Next
For index = location + 1 To data.GetUpperBound(0)
Dim SplitData = data(index).Split("|"c)
Dim Run As New Runner
Run.BibNum = CInt(SplitData(0))
Run.SchoolCode = SplitData(1)
Run.FirstName = SplitData(2)
Run.LastName = SplitData(3)
Runners.Add(Run)
Next
End Sub
Private Function FindRosterLine(s As String) As Boolean
If s.Trim.StartsWith("# Roster") Then
Return True
Else
Return False
End If
End Function
Private Sub FillListBoxes()
Dim arrRunners As Runner() = Runners.ToArray
Dim arrSchools As School() = Schools.ToArray
ListBox1.Items.AddRange(arrSchools)
ListBox2.Items.AddRange(arrRunners)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim arrRunner = ReadData("Runners.txt")
FillLists(arrRunner)
FillListBoxes()
End Sub
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged
Dim Schl = DirectCast(ListBox1.SelectedItem, School)
TextBox1.Text = Schl.CoachLName
TextBox2.Text = Schl.Code
End Sub
I'm not sure if my title is exactly what I need so let me explain.
What I'm doing is making a "simple" game that list a US State (at random into a label) and then below the label is 5 Buttons of which I am trying to change the text to the buttons to random State Capital (all of the Capitals need to be random except for the correct one) After hours of researching with no luck it seems that I am not the only one trying get help with this. If you can help it would be great!
Private Class Players
Public Team As String
Public Name As String
Public Sub New(ByVal Team As String, ByVal Name As String)
Me.Team = Team
Me.Name = Name
End Sub
End Class
' Arraylist
Dim lstCapitals As New ArrayList
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim list As New List(Of Players)
' Capital Names
lstCapitals.Add("Montgomery")
lstCapitals.Add("Juneau")
lstCapitals.Add("Phoenix")
lstCapitals.Add("Little Rock")
lstCapitals.Add("Sacramento")
lstCapitals.Add("Denver")
lstCapitals.Add("Hartford")
' Random number generator
Dim randomInt As New Random
' Pulls a name randomly from the list
Dim stringname As String = lstCapitals.Item(randomInt.Next(0, 6))
'6 = lstCapitals.Count / one line up
' Show the name
'stateNamelbl.Show()
'NOT SURE IF I NEEDED THIS OR NOT THATS WHY ITS COMMENTED OUT
'Dim RandomList = From RndList In (From xitem In list Select xitem Group By xitem.Team Into First()) _
' Select RndList _
' Order By Rnd()
For Each item In lstCapitals
Randomize()
MsgBox(item.Team)
Next
End Sub
Your sample code doesn't explain how you choose the US State so I assume that you will have the value in a string somewhere. Here is a simple method you could use to generate a random string array to hold the values of the state capitals:
Dim sCorrectStateCapital As String = "Denver" ' This is hardcoded to "Denver" assuming that "Colorado" was the current US State you are playing the game for - you need to come up with your own logic to figure out how this works as I have no idea how you are choosing the State
Dim nButtonCount As Integer = 5 ' This is hardcoded to five since you have five buttons
Dim sCapitalsArray(nButtonCount - 1) As String ' Create the string array to hold the chosen capitals
' Loop five times and choose a different state capital each time
For i As Int32 = 0 To sCapitalsArray.Length - 1
Dim nTempIndex As Int32 = randomInt.Next(0, lstCapitals.Count - 1) ' Save the index value of the arraylist that we are choosing
sCapitalsArray(i) = lstCapitals.Item(nTempIndex) ' Populate the captials array
lstCapitals.RemoveAt(nTempIndex) ' Remove the selected capital from the list of possible choices since we do not want to choose it again
Next
' Test to see if the capitals array already contains the "correct" value
If Not sCapitalsArray.Contains(sCorrectStateCapital) Then
' The correct value is not already in the list so we overwrite one of the values in the array at a random index
sCapitalsArray(randomInt.Next(0, sCapitalsArray.Count - 1)) = sCorrectStateCapital
End If
The Form below has...
3 Labels: lblState, lblScore, lblAnswer
5 Buttons: btnCapital1, btnCapital2, btnCapital3, btnCapital4, btnCapital5
Public Class frmStateCapitalsQuiz
Public Class State
Public Name As String
Public Capital As String
Public Sub New(ByVal data As String)
Dim values() As String = data.Split(",")
Me.Name = values(0)
Me.Capital = values(1)
End Sub
Public Overrides Function ToString() As String
Return Me.Capital & ", " & Me.Name
End Function
End Class
Private R As New Random
Private Count As Integer
Private Correct As Integer
Private States As List(Of State)
Private CurrentState As State = Nothing
Private CurrentStateSet As List(Of State)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadStateData()
GenerateQuestion()
lblScore.Text = "Score: "
lblAnswer.Text = ""
End Sub
Private Sub LoadStateData()
States = New List(Of State)
Dim StateData As String = "Alabama,Montgomery;Alaska,Juneau;Arizona,Phoenix;Arkansas,Little Rock;California,Sacramento;Colorado,Denver;Connecticut,Hartford;Delaware,Dover;Florida,Tallahassee;Georgia,Atlanta;Hawaii,Honolulu;Idaho,Boise;Illinois,Springfield;Indiana,Indianapolis;Iowa,Des Moines;Kansas,Topeka;Kentucky,Frankfort;Louisiana,Baton Rouge;Maine,Augusta;Maryland,Annapolis;Massachusetts,Boston;Michigan,Lansing;Minnesota,St. Paul;Mississippi,Jackson;Missouri,Jefferson City;Montana,Helena;Nebraska,Lincoln;Nevada,Carson City;New Hampshire,Concord;New Jersey,Trenton;New Mexico,Santa Fe;New York,Albany;North Carolina,Raleigh;North Dakota,Bismarck;Ohio,Columbus;Oklahoma,Oklahoma City;Oregon,Salem;Pennsylvania,Harrisburg;Rhode Island,Providence;South Carolina,Columbia;South Dakota,Pierre;Tennessee,Nashville;Texas,Austin;Utah,Salt Lake City;Vermont,Montpelier;Virginia,Richmond;Washington,Olympia;West Virginia,Charleston;Wisconsin,Madison;Wyoming,Cheyenne"
For Each pair As String In StateData.Split(";")
States.Add(New State(pair))
Next
End Sub
Private Sub GenerateQuestion()
Dim shuffledStates = States.OrderBy(Function(x) R.NextDouble()).Take(5).ToList
CurrentState = shuffledStates(R.Next(shuffledStates.Count))
lblState.Text = CurrentState.Name
btnCapital1.Text = shuffledStates(0).Capital
btnCapital2.Text = shuffledStates(1).Capital
btnCapital3.Text = shuffledStates(2).Capital
btnCapital4.Text = shuffledStates(3).Capital
btnCapital5.Text = shuffledStates(4).Capital
End Sub
Private Sub btnCapitals_Click(sender As Object, e As EventArgs) Handles btnCapital1.Click, btnCapital2.Click, btnCapital3.Click, btnCapital4.Click, btnCapital5.Click
Dim SelectedCaptial As Button = DirectCast(sender, Button)
lblAnswer.Text = CurrentState.ToString
Count = Count + 1
If SelectedCaptial.Text = CurrentState.Capital Then
lblScore.BackColor = Color.Green
Correct = Correct + 1
Else
lblScore.BackColor = Color.Red
End If
Dim percentCorrect = CInt(CDbl(Correct) / CDbl(Count) * 100)
lblScore.Text = String.Format("Score: {0} / {1}, {2}% Correct", Correct, Count, percentCorrect)
GenerateQuestion()
End Sub
End Class
my question is how to anchor a child mdi to its parent mdi so that each time the user expands or minimizes the parent form the child form automatically follows. I already tried to use the resize function in form but it doesn't help
thanks all help is appriciated
See below - a quick version I wrote, which seems to handle most anchoring scenarios. You may need to polish this code a bit. But this should get you started:
Imports System.ComponentModel
Public Class MDIChildForm
Dim p_eMyAnchor As AnchorStyles
Dim p_mdiParent As Form
Dim p_iOldHeight, p_iOldWidth As Integer
<DefaultValue(AnchorStyles.Left Or AnchorStyles.Top)>
Public Property MyAnchor As AnchorStyles
Get
Return p_eMyAnchor
End Get
Set(value As AnchorStyles)
p_eMyAnchor = value
chkAnchorTop.Checked = (p_eMyAnchor And AnchorStyles.Top)
chkAnchorLeft.Checked = (p_eMyAnchor And AnchorStyles.Left)
chkAnchorRight.Checked = (p_eMyAnchor And AnchorStyles.Right)
chkAnchorBottom.Checked = (p_eMyAnchor And AnchorStyles.Bottom)
End Set
End Property
Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
p_eMyAnchor = AnchorStyles.Left Or AnchorStyles.Top
End Sub
Public Sub ShowAsMDIChild(mdiParent As Form)
p_mdiParent = mdiParent
Me.MdiParent = mdiParent
AddHandler mdiParent.ResizeBegin, AddressOf MDIParentForm_ResizeBegin
AddHandler mdiParent.ResizeEnd, AddressOf MDIParentForm_ResizeEnd
Me.Show()
End Sub
Private Sub MDIParentForm_ResizeBegin(sender As Object, e As EventArgs)
Dim frm As Form = DirectCast(sender, Form)
p_iOldWidth = frm.Width
p_iOldHeight = frm.Height
End Sub
Private Sub MDIParentForm_ResizeEnd(sender As Object, e As EventArgs)
Dim parentForm As Form = DirectCast(sender, Form)
'handling for horizontal anchoring
Dim deltaWidth As Integer = parentForm.Width - p_iOldWidth
Dim fAnchorLeft As Boolean = p_eMyAnchor And AnchorStyles.Left
Dim fAnchorRight As Boolean = p_eMyAnchor And AnchorStyles.Right
Select Case fAnchorLeft
Case True : If fAnchorRight Then Me.Width += deltaWidth
Case False
Dim coef As Single = If(fAnchorRight, 1, 0.5)
Me.Left += deltaWidth * coef
End Select
'handling for vertical anchoring
Dim deltaHeight As Integer = parentForm.Height - p_iOldHeight
Dim fAnchorTop As Boolean = p_eMyAnchor And AnchorStyles.Top
Dim fAnchorBottom As Boolean = p_eMyAnchor And AnchorStyles.Bottom
Select Case fAnchorTop
Case True : If fAnchorBottom Then Me.Height += deltaHeight
Case False
Dim coef As Single = If(fAnchorBottom, 1, 0.5)
Me.Top += deltaHeight * coef
End Select
End Sub
End Class
For horizonal anchoring, the following rules are used:
left - nothing happens (default behavior)
left and right - expand width to parent form width delta
right - move left by parent form width delta
no anchor - move left by half parent form width delta.
Same principle applies to vertical anchoring, for top and bottom respectively.
You can get the full project to play with here (Mediafire).
try this:
Me.Anchor = AnchorStyles.Bottom
Me.Anchor = AnchorStyles.Left
Me.Anchor = AnchorStyles.Right
Me.Anchor = AnchorStyles.Top
I have a search box that works great in WinForms, but is giving me trouble in WPF.
It works by starting a search each time a letter is pushed, similar to Google.
If (txtQuickSearch.Text.Length >= 3) Or (e.Key = Key.Enter) Then
If SearchWorker.IsBusy Then
SearchWorker.CancelAsync()
Do While SearchWorker.IsBusy
'Application.DoEvents()
'System.Threading.Thread.Sleep(500)
Loop
End If
doSearchText = txtQuickSearch.Text
SearchWorker.RunWorkerAsync()
End If
Every time a key is pushed it cancels the current searchWorker then restarts it. In WinForms the Do while searchworker.isbusy doevents loop worked great, but since I don't have access to that anymore, I need to figure out a better way to do it. Sleep() deadlocks it, and I've tried just doing i+=1 as a way to pass time until it's not busy, but that doesn't work either...
What should I do?
Update: Here's what I changed it to. It works, but the cancel part doesn't seem to ever trigger, this doesn't seem to be running async...
Imports System.ComponentModel
Imports System.Collections.ObjectModel
Imports System.Threading
Imports System.Threading.Tasks
Public Class QuickSearch
Private doSearchText As String
Private canceled As Boolean
Private curSearch As String
Dim searchResults As New ObservableCollection(Of ocSearchResults)
'Task Factory
Private cts As CancellationTokenSource
Private searchtask As Task(Of ObservableCollection(Of ocSearchResults))
Private Sub txtQuickSearch_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Input.KeyEventArgs) Handles txtQuickSearch.KeyDown
If e.Key = Key.Enter Then
curSearch = ""
End If
If ((txtQuickSearch.Text.Length >= 3) Or (e.Key = Key.Enter)) And Not txtQuickSearch.Text = curSearch Then
If Not cts Is Nothing Then
cts.Cancel()
ColorChecker.CancelAsync()
Try
' searchtask.Wait()
Catch ex As AggregateException
MsgBox(ex.InnerException.Message)
End Try
cts = New CancellationTokenSource
Else
cts = New CancellationTokenSource
End If
Dim cToken = cts.Token
Me.Height = 400
doSearchText = txtQuickSearch.Text
'This always completes fully before continuing on to tRunWorkerComplete(searchtask.Result) '
searchtask = Task(Of ObservableCollection(Of ocSearchResults)).Factory.StartNew(Function() tPerformSearch(cToken), cToken)
Try
tRunWorkerCompleted(searchtask.Result)
Catch ex As AggregateException
' MsgBox(ex.InnerException.Message)
End Try
Else
If Not cts Is Nothing Then
cts.Cancel()
End If
searchResults.Clear()
End If
End Sub
Function tPerformSearch(ByVal ct As CancellationToken) As ObservableCollection(Of ocSearchResults)
On Error GoTo sError
canceled = False
If curSearch = doSearchText Then
canceled = True
Return Nothing
End If
curSearch = doSearchText
Dim SR As New ObservableCollection(Of ocSearchResults)
Dim t As ocSearchResults
Dim rSelect As New ADODB.Recordset
Dim sSql As String = "SELECT DISTINCT CustomerID, CustomerName, City, State, Zip FROM qrySearchFieldsQuick WHERE "
Dim sWhere As String = "CustomerName Like '" & doSearchText & "%'"
SR.Clear()
With rSelect
.Open(sSql & sWhere & " ORDER BY CustomerName", MyCn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
Do While Not .EOF
If ct.IsCancellationRequested Then ' This never shows true, the process always returns a value, as if it wasn't async'
canceled = True
Return Nothing
End If
Do While IsDBNull(.Fields("CustomerID").Value)
.MoveNext()
Loop
t = New ocSearchResults(.Fields!CustomerID.Value, .Fields!CustomerName.Value.ToString.Trim, .Fields!City.Value.ToString.Trim, .Fields!State.Value.ToString.Trim, .Fields!Zip.Value.ToString.Trim)
If Not SR.Contains(t) Then
SR.Add(t)
End If
aMoveNext:
.MoveNext()
Loop
.Close()
End With
Return SR
Exit Function
sError:
MsgBox(ErrorToString, MsgBoxStyle.Exclamation)
End Function
Sub tRunWorkerCompleted(ByVal SR As ObservableCollection(Of ocSearchResults))
If canceled Then
Exit Sub
End If
If cts.IsCancellationRequested Then
Exit Sub
End If
searchResults.Clear()
For Each t As ocSearchResults In SR
searchResults.Add(t)
Next
ColorChecker = New BackgroundWorker
ColorChecker.WorkerReportsProgress = True
ColorChecker.WorkerSupportsCancellation = True
ColorChecker.RunWorkerAsync(searchResults)
lblRecordCount.Text = "(" & searchResults.Count & ") Records"
progBar.Value = 100
Exit Sub
sError:
MsgBox(ErrorToString)
End Sub
I don't know enough VB to give you any well written sample code, but if you're on .Net 4.0 I suggest switching to the System.Threading.Tasks namespace, which has cancellation abilities.
If (txtQuickSearch.Text.Length >= 3) Or (e.Key = Key.Enter) Then
If TokenSource Is Not Nothing Then
TokenSource.Cancel()
TokenSource = New CancellationTokenSource()
End If
Task.Factory.StartNew(SomeSearchMethod, txtQuickSearch.Text, TokenSource.Token)
End If
I am not sure a BackgroundWorker is flexible enough to provide an elegant solution for this type of background processing anyway. I think what I would do is to create a single dedicated thread for doing the searching. This thread would use the producer-consumer pattern for accepting work items and processing them.
The following code is a rough sketch of how I see this strategy working. You would call the SearchAsync method to request a new search. That method accepts a callback that gets invoked when and if the search operation found something. Notice that the consumer code (in the Run method) cancels its current search operation if another search request is queued. The effect is that the consumer only ever processes the latest request.
Public Class Searcher
Private m_Queue As BlockingCollection(Of WorkItem) = New BlockingCollection(Of WorkItem)()
Public Sub New()
Dim t = New Thread(AddressOf Run)
t.IsBackground = True
t.Start()
End Sub
Public Sub SearchAsync(ByVal text As String, ByVal callback As Action)
Dim wi = New WorkItem()
wi.Text = text
wi.Callback = callback
m_Queue.Add(wi)
End Sub
Private Sub Run()
Do While True
Dim wi As WorkItem = m_Queue.Take()
Dim found As Boolean = False
Do While Not found AndAlso m_Queue.Count = 0
' Continue searching using your custom algorithm here.
Loop
If found Then
wi.Callback()
End If
Loop
End Sub
Private Class WorkItem
Public Text As String
Public Callback As Action
End Class
End Class
Here is where the elegance happens. Look at how you can implement the logic from the UI thread now.
If (txtQuickSearch.Text.Length >= 3) Or (e.Key = Key.Enter) Then
searcher.SearchAsync(txtQuickSearch.Text, AddressOf OnSearchComplete)
End If
Note that OnSearchComplete will be executed on the worker thread so you will need to call Dispatcher.Invoke from within the callback if you want to publish the results to a UI control.
You can simulate a DoEvents in WPF by doing (in C#):
Dispatcher.Invoke(DispatcherPriority.Background, new Action(() => {}));
VB.NET 2010, .NET 4
Hello,
I've looked around and can't seem to find a solution to my problem. I have an EventLog object which inherits DataGridView and has a public variable EventList which is a List(Of EventLogItem). EventLogItem has seven properties which describe the event, including Index which is set to EventList.Count each time an entry is added (so, it should be unique). Everything has worked just fine until I tried to add an entry from a serial port DataReceived event handler upon which I receive the following exception:
An error occurred creating the form. See Exception.InnerException for details. The error is: An item with the same key has already been added.
Clicking 'View Details' and expanding the InnerException yields no more information. Here is some relevant code:
The EventLog class with its EventList:
Public Class EventLog
Inherits DataGridView
Public EventList As New List(Of EventLogItem)
..Column creation code, etc..
End Class
The EventLogItem class:
Public Class EventLogItem
Public Property Index As Integer
Public Property Timestamp As String
Public Property User As String = String.Empty
Public Property [Step] As String = String.Empty
Public Property Type As Types
Public Property Message As String
Public Property TypeIcon As Image
Public Enum Types
SeriousError = -2
NormalError = -1
Warning = 0
NormalEvent = 1
ImportantEvent = 2
ManualEntry = 3
End Enum
Private Sub New()
Me.Timestamp = DateTime.Now.ToString("MM/dd/yyyy HH:mm:ss.f")
Me.Type = Types.NormalEvent
SetTypeIcon()
End Sub
Public Sub New(ByVal Message As String)
Me.New()
Me.Message = Message
End Sub
Public Sub New(ByVal Message As String, ByVal User As String)
Me.New()
Me.Message = Message
Me.User = User
End Sub
Public Sub New(ByVal Message As String, ByVal User As String, ByVal Type As Types)
Me.New(Message, User)
Me.Type = Type
SetTypeIcon()
End Sub
Public Sub New(ByVal Message As String, ByVal User As String, ByVal Type As Types, ByVal [Step] As Integer)
Me.New(Message, User, Type)
Me.Step = ([Step] + 1).ToString
End Sub
Private Sub SetTypeIcon()
Select Case Me.Type
Case Types.NormalError
Me.TypeIcon = My.Resources.ErrorIcon
Case Types.SeriousError
Me.TypeIcon = My.Resources.ErrorIcon
Case Types.Warning
Me.TypeIcon = My.Resources.WarningIcon
Case Types.ManualEntry
Me.TypeIcon = My.Resources.ManualIcon
Case Else
Me.TypeIcon = My.Resources.OkayIcon
End Select
End Sub
End Class
Code for inserting an item into the event log:
Inside my main-form class:
Public Sub NewEventLogEntry(ByVal Message As String, ByVal ex As Exception, ByVal Type As EventLogItem.Types, ByVal IncludeProcessStepNumber As Boolean)
If IncludeProcessStepNumber Then
SafeInvokeControl(EventLog, Sub(x)
Dim FirstRow As Integer = x.FirstDisplayedScrollingRowIndex
Dim [Event] As New EventLogItem(Message, My.Settings.SelectedUser, Type, Device.CurrentProcessStep)
[Event].Index = x.RowCount + 1
x.EventList.Insert(0, [Event])
x.DataSource = GetType(List(Of EventLogItem))
x.DataSource = x.EventList
x.SetRowStyles()
If FirstRow >= 0 And FirstRow < x.RowCount Then x.FirstDisplayedScrollingRowIndex = FirstRow
End Sub)
Else
SafeInvokeControl(EventLog, Sub(x)
Dim FirstRow As Integer = x.FirstDisplayedScrollingRowIndex
Dim [Event] As New EventLogItem(Message, My.Settings.SelectedUser, Type)
[Event].Index = x.RowCount + 1
x.EventList.Insert(0, [Event])
x.DataSource = GetType(List(Of EventLogItem))
x.DataSource = x.EventList
x.SetRowStyles()
If FirstRow >= 0 And FirstRow < x.RowCount Then x.FirstDisplayedScrollingRowIndex = FirstRow
End Sub)
End If
If Type < EventLogItem.Types.Warning Then
Dim ErrorBox As New ErrorBox
Dim ErrorBoxThread As New Threading.Thread(AddressOf ErrorBox.ShowDialog)
ErrorBoxThread.IsBackground = True
ErrorBox.Exception = ex
If Type = EventLogItem.Types.NormalError Then
ErrorBox.Type = ErrorBox.Types.Error
ErrorBox.Message = Message
ElseIf Type = EventLogItem.Types.SeriousError Then
ErrorBox.Type = ErrorBox.Types.SeriousError
ErrorBox.Message = Message & vbNewLine & vbNewLine & "This is a serious error and indicates that the program is " & _
"unstable. The source of this error should be corrected before this program is used for anything important."
End If
StopMasterTimer()
ErrorBoxThread.Start()
End If
End Sub
end main-form class snippet
The code that's causing the problem (ch4cp is my namespace. this code resides in a class other than my main-form class):
Inside a serial port device class:
<Runtime.CompilerServices.MethodImplAttribute(Runtime.CompilerServices.MethodImplOptions.Synchronized)> _
Private Shared Sub Port_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles Port.DataReceived
..some code..
ch4cp.NewEventLogEntry("testing")
..some more code..
End Sub
End serial port device class snippet
Any ideas?
Thanks a lot in advance.
It sounds like you are getting a thread exception error in your code somewhere. The threading problem will cause other issues and not appear until you step through the code and look at each line being executed.
Try the following at the beginning of your code block to try to identify the problem.
Control.CheckForIllegalCrossThreadCalls = false