Develop Reference

How to close all anonym, running Excel applications without killing [duplicate]

I want to use something similar to
GetObject(,"Excel.Application") to get back the application I created.
I call CreateObject("Excel.Application") to create Excel instances. Later if the VBA project resets, due to debugging and coding, the Application object variables are lost but the Excel instances are running in the background. Kind of a memory leak situation.
I want to re-attach to either re-use (preferred way) or close them.

To list the running instances of Excel:
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Sub Test()
Dim xl As Application
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.ActiveWorkbook.FullName
Next
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function

This would be best as a comment on Florent B.'s very useful function that returns a collection of the open Excel instances, but I don't have sufficient reputation to add comments. In my tests, the collection contained "repeats" of the same Excel instances i.e. GetExcelInstances().Count was larger than it should have been. A fix for that is the use of the AlreadyThere variable in the version below.
Private Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Dim AlreadyThere As Boolean
Dim xl As Application
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
AlreadyThere = False
For Each xl In GetExcelInstances
If xl Is acc.Application Then
AlreadyThere = True
Exit For
End If
Next
If Not AlreadyThere Then
GetExcelInstances.Add acc.Application
End If
End If
Loop
End Function

#PGS62/#Philip Swannell has the correct answer for returning a Collection; I can iterate all instances; and it is brilliant, as #M1chael comment.
Let's not confuse Application objects with Workbook objects... ...Of
course it would be possible to write a nested loop that loops over the
workbooks collection of each application object
This is the nested loop implemented and fully functional:
Sub Test2XL()
Dim xl As Excel.Application
Dim i As Integer
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.Application.hwnd
Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
For i = 1 To xl.Application.Workbooks.Count
Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
Debug.Print "Workbook path: " & xl.Application.Workbooks(i).path
Next i
Next
Set xl = Nothing
End Sub
And, for Word instances, the nested loop:
Sub Test2Wd()
Dim wd As Word.Application
Dim i As Integer
For Each wd In GetWordInstancesCol()
Debug.Print "Version: " & wd.System.Version
Debug.Print "# Documents: " & wd.Application.Documents.Count
For i = 1 To wd.Application.Documents.Count
Debug.Print "Document: " & wd.Application.Documents(i).Name
Debug.Print "Document path: " & wd.Application.Documents(i).path
Next i
Next
Set wd = Nothing
End Sub
For Word you have to use what is explained in the end of this thread

I use the following to check if two instances are running, and display a message. It could be altered to close other instance... This may be of help... I need code to return a specific instance, and return for use similar to GetObject(,"Excel.Application")... I don't think it possible though
If checkIfExcelRunningMoreThanOneInstance() Then Exit Function
In module (some of the declarations are possible used for other code):
Const MaxNumberOfWindows = 10
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global ret As Integer
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const VK_CAPITAL = &H14
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Global ExcelWindowName$ 'Used to switch back to later
Function checkIfExcelRunningMoreThanOneInstance()
'Check instance it is 1, else ask user to reboot excel, return TRUE to abort
ExcelWindowName = excel.Application.Caption 'Used to switch back to window later
If countProcessRunning("excel.exe") > 1 Then
Dim t$
t = "Two copies of 'Excel.exe' are running, which may stop in cell searching from working!" & vbCrLf & vbCrLf & "Please close all copies of Excel." & vbCrLf & _
" (1 Then press Alt+Ctrl+Del to go to task manager." & vbCrLf & _
" (2 Search the processes running to find 'Excel.exe'" & vbCrLf & _
" (3 Select it and press [End Task] button." & vbCrLf & _
" (4 Then reopen and use PostTrans"
MsgBox t, vbCritical, ApplicationName
End If
End Function
Private Function countProcessRunning(ByVal sProcess As String) As Long
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String
countProcessRunning = 0
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then
countProcessRunning = countProcessRunning + 1
End If
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function
The I found:
Dim xlApp As Excel.Application
Set xlApp = GetObject("ExampleBook.xlsx").Application
Which gets the object if you know the name of the sheet currently active in Excel instance. I guess this could be got from the application title using the first bit of code. In my app I do know the filename.

This can accomplish what you want.
Determine if an instance of Excel is open:
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
If an instance is running you can access it using the xlApp object. If an instance is not running you will get a run-time error (you might need/want an error handler). The GetObject function gets the first instance of Excel that had been loaded. You can do your job with it, and to get to others, you can close that one and then try GetObject again to get the next one, etc.
So you will be attaining your ok-but-second-preferred objective
(taken from http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html).
For attaining your preferred objective, I think that https://stackoverflow.com/a/3303016/2707864 shows you how.

Create an array of objects and store the newly created Excel.Application in the array. That way you can reference them as and when you need. Let's take a quick example:
In a module:
Dim ExcelApp(2) As Object
Sub Test()
Set ExcelApp(1) = CreateObject("Excel.Application")
ExcelApp(1).Visible = True
Set ExcelApp(2) = CreateObject("Excel.Application")
ExcelApp(2).Visible = True
End Sub
Sub AnotherTest()
ExcelApp(1).Quit
ExcelApp(2).Quit
End Sub
Run Test() macro and you should see two Excel Applications pop up. Then run AnotherTest() and the Excel Applications will quit. You can even set the array to Nothing after you are done.
You can get handle of running Excel applications using the script published on http://www.ozgrid.com/forum/showthread.php?t=182853. That should get you where you want to go.

You should use this code every time you need an Excel application object. This way, your code will only ever work with one application object or use a pre-existing one. The only way you could end up with more than one is if the user started more than one. This is both the code to open Excel and attach and reuse, like you want.
Public Function GetExcelApplication() As Object
On Error GoTo openExcel
Set GetExcelApplication = GetObject(, "Excel.Application")
Exit Function
openExcel:
If Err.Number = 429 Then
Set GetExcelApplication = CreateObject("Excel.Application")
Else
Debug.Print "Unhandled exception: " & Err.Number & " " & Err.Description
End If
End Function
If you wanted to close multiple instances you would need to call GetObject followed by .Close in a loop until it throws the error 429.
The details can be found in this Article

How to implement/override Protected List.Contains() for a custom Collection Class using a property of item

I'm not entirely sure that my wording is correct on the title above. I guess the easiest way to explain it is to put the code below for reference and then give what I'd like to have as the expected behavior.
Public Class Domino
Public ReadOnly MinimumSideValue As Integer = 0
Public ReadOnly MaximumSideValue As Integer = 6
Public Property key As Integer
Public Property Side1 As Integer
Public Property Side2 As Integer
Public Sub New(side1Value As Integer, side2Value As Integer)
Me.Side1 = side1Value
Me.Side2 = side2Value
' Key should be a two digit number. side values 5 and 1 -> 51
Me.key = Integer.Parse(Side1.ToString & Side2.ToString)
End Sub
Public Overrides Function ToString() As String
Return Convert.ToString(Me.key)
End Function
End Class
Public Class DominoCollection
Inherits System.Collections.CollectionBase
Public Sub AddDomino(newDomino As Domino)
' Not sure if I should be calling Contains on the Protected List object
If Not List.Contains(newDomino) Then
List.Add(newDomino)
End If
End Sub
Public Function Contains(objDomino as Domino) As Boolean
' Need to check if a domino that has the same key already exists
Dim found As Boolean = False
For i = 0 To List.Count - 1 'This will fail if the list is empty...
If DirectCast(List.Item(i), Domino).key = objDomino.key Then found = True
Next
Return found
End Function
End Class
The fist code listing is the class that will have multiple instances created. The second class is the collection that will contain instances of the first class. The collection should not contain duplicate items. So when I call the contains method on the built-in protected List object from the CollectionBase I'd like it to search the list of items looking for a duplicate with the same value in the key property of the first class.
I'm not entirely sure if I can override the List.Contains method because it's a protected object and/or if I should really be creating my own contains method. I tried creating my own .Contains method, but it fails if the list is empty.
EDIT
I know that my code isn't in C#. However since it's .NET, C# answers would help just as much as VB would.
EDIT: Revised Code
After seeing some of the solutions below I've got the following that so far is looking like it will work as I wanted. However I'm not sure I implemented the Item property correctly. I haven't tested it as of yet because I'm not to the point of being able to use it in the rest of the application, I'm just trying to get a framework down.
Friend Class DominoCollection
Private domCol As Dictionary(Of Integer, Domino)
Public ReadOnly Property Keys As System.Collections.Generic.Dictionary(Of Integer, Domino).KeyCollection
Get
Return domCol.Keys
End Get
End Property
Public ReadOnly Property Values As System.Collections.Generic.Dictionary(Of Integer, Domino).ValueCollection
Get
Return domCol.Values
End Get
End Property
Default Public Property Item(DominoKey As Integer) As Domino
Get
If domCol.ContainsKey(DominoKey) Then
Return domCol.Item(DominoKey)
Else
Throw New KeyNotFoundException(String.Format("Cannot find key {0} in internal collection"))
End If
End Get
Set(value As Domino)
If domCol.ContainsKey(DominoKey) Then
domCol.Item(DominoKey) = value
Else
Throw New KeyNotFoundException(String.Format("Cannot find key {0} in internal collection"))
End If
End Set
End Property
Default Public Property Item(domino As Domino) As Domino
Get
If domCol.ContainsKey(domino.key) Then
Return domCol.Item(domino.key)
Else
Throw New KeyNotFoundException(String.Format("Cannot find key {0} in internal collection"))
End If
End Get
Set(value As Domino)
If domCol.ContainsKey(domino.key) Then
domCol.Item(domino.key) = value
Else
Throw New KeyNotFoundException(String.Format("Cannot find key {0} in internal collection"))
End If
End Set
End Property
Public Sub New()
domCol = New Dictionary(Of Integer, Domino)
End Sub
Public Sub Add(dom As Domino)
If Not domCol.ContainsKey(dom.key) Then
domCol.Add(dom.key, dom)
End If
End Sub
Public Function Contains(dom As Domino) As Boolean
Return domCol.ContainsKey(dom.key)
End Function
' flexibility:
Public Function Remove(dom As Domino) As Boolean
If domCol.ContainsKey(dom.key) Then
domCol.Remove(dom.key)
Return True
Else
Return False
End If
End Function
Public Function Remove(key As Integer) As Boolean
If domCol.ContainsKey(key) Then
domCol.Remove(key)
Return True
Else
Return False
End If
End Function
Public Function Count() As Integer
Return domCol.Count
End Function
Public Sub Clear()
domCol.Clear()
End Sub
End Class

Given the central importance of Domino.Key, I think a class which uses a Dictionary would make things easiest. Since your code is always looking for that to decide if a Domino object exists etc, a Dictionary will help detect that and prevent dupes etc.
Friend Class DominoCollection
Private mcol As Dictionary(Of Integer, Domino)
Public Sub New()
mcol = New Dictionary(Of Integer, Domino)
End Sub
Public Sub Add(dom As Domino)
If mcol.ContainsKey(dom.key) = False Then
mcol.Add(dom.key, dom)
' optional: replace - dont know if this is needed
Else
mcol(dom.key) = dom
End If
End Sub
Public Function Contains(dom As Domino) As Boolean
Return mcol.ContainsKey(dom.key)
End Function
' flexibility:
Public Function Remove(dom As Domino) As Boolean
If mcol.ContainsKey(dom.key) Then
mcol.Remove(dom.key)
Return True
End If
Return False
End Function
Public Function Remove(key As Integer) As Boolean
If mcol.ContainsKey(key) Then
mcol.Remove(key)
Return True
End If
Return False
End Function
End Class
For an Item and Items:
Public Function Item(key As Integer) As Domino
Return mcol(key)
End Function
Public Function Items() As List(Of Domino)
Return New List(Of Domino)(mcol.Values)
End Function
Items hides the KeyValuePair typically required to iterate and allows you to do a simple For/Each loop on the collection (of needed):
Dim doms As New DominoCollection
doms.Add(New Domino(1, 2))
doms.Add(New Domino(2, 3))
doms.Add(New Domino(4, 6))
For Each d As Domino In doms.Items
Console.WriteLine("s1:{0} s2:{1} k:{2}", d.Side1, d.Side2, d.key.ToString)
Next
Output
s1:1 s2:2 k:12
s1:2 s2:3 k:23
s1:4 s2:6 k:46

Yes, you definitely should either inherit from a generic collection class or implement a generic collection interface.
I'm not sure on the exact syntax for VB, but I think instead of List.Contains you want to use the Linq extension Any with a lambda. I think it goes something like this:
List.Any(Function(d as Domino) d.key = newDomino.key)
This will return true if any of the elements inside List matches the key.

Need a VB.net Combobox derived class for pattern matched or contains autocomplete functionality [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
Ive searched everywhere on the net for a solution to this common pain. Surely someone out there has a solution or can help me implement one ????
Basically the default combobox in vb.net autocompletes using a limited "StartsWith" pattern match (for example, when you type any letter, only the listitems.text that start with that letter will be filtered and shown in the dropdownlist.
There isnt an obviously simple switch to change the way these are filtered and so I assume that the best way to solve this issue is to derive/inherit the combobox class and modify it to use String.contains() ?? Only issue i have never done a derived class and would really appreciate some help with this specific problem.
Also, I found a C# solution that seems to exactly solve this issue (http://www.codeproject.com/Tips/631196/ComboBox-with-Suggest-Ability-based-on-Substring-S) and ive tried everything to convert or code something similar with little success :(
Im amazed this is still unsolved, since so many people on the net have asked for a solution to this limitation !!!!

Yes it can be done in VB.NET. I was on the same thought process of that you could just try converting the code in the link you posted from C# to VB.NET as the previous comments suggested. However when I tried doing so the resulting VB wouldn't compile. After fixing numerous build errors and some syntax errors I present to you the VB version of the SuggestComboBox and how it is used. The only reason why I'm posting this answer is because the conversion from C# to VB wasn't straightforward, and the license the source is released under allows me to do so.
Source
License
You need to add the control via the code behind of the form, I couldn't find a designer portion in the source (blame my lacking knowledge of C# on that).
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Drawing
Imports System.Linq
Imports System.Linq.Expressions
Imports System.Windows.Forms
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim testbox As New AutoCompleteComboBox.SuggestComboBox
Me.Controls.Add(testbox)
testbox.DataSource = New List(Of String) From {"Janean Mcgaha", "Tama Gaitan", "Jacque Tinnin", "Elvira Woolfolk", "Fransisca Owens", "Minnie Ardoin", _
"Renay Bentler", "Joye Boyter", "Jaime Flannery", "Maryland Arai", "Walton Edelstein", "Nereida Storrs", _
"Theron Zinn", "Katharyn Estrella", "Alline Dubin", "Edra Bhatti", "Willa Jeppson", "Chelsea Revel", _
"Sonya Lowy", "Danelle Kapoor"}
End Sub
End Class
Namespace AutoCompleteComboBox
Public Class SuggestComboBox
Inherits ComboBox
#Region "fields and properties"
Private ReadOnly _suggLb As New ListBox() With {.Visible = False, .TabStop = False}
Private ReadOnly _suggBindingList As New BindingList(Of String)()
Private _propertySelector As Expression(Of Func(Of ObjectCollection, IEnumerable(Of String)))
Private _propertySelectorCompiled As Func(Of ObjectCollection, IEnumerable(Of String))
Private _filterRule As Expression(Of Func(Of String, String, Boolean))
Private _filterRuleCompiled As Func(Of String, Boolean)
Private _suggestListOrderRule As Expression(Of Func(Of String, String))
Private _suggestListOrderRuleCompiled As Func(Of String, String)
Public Property SuggestBoxHeight() As Integer
Get
Return _suggLb.Height
End Get
Set(value As Integer)
If value > 0 Then
_suggLb.Height = value
End If
End Set
End Property
''' <summary>
''' If the item-type of the ComboBox is not string,
''' you can set here which property should be used
''' </summary>
Public Property PropertySelector() As Expression(Of Func(Of ObjectCollection, IEnumerable(Of String)))
Get
Return _propertySelector
End Get
Set(value As Expression(Of Func(Of ObjectCollection, IEnumerable(Of String))))
If value Is Nothing Then
Return
End If
_propertySelector = value
_propertySelectorCompiled = value.Compile()
End Set
End Property
'''<summary>
''' Lambda-Expression to determine the suggested items
''' (as Expression here because simple lamda (func) is not serializable)
''' <para>default: case-insensitive contains search</para>
''' <para>1st string: list item</para>
''' <para>2nd string: typed text</para>
'''</summary>
Public Property FilterRule() As Expression(Of Func(Of String, String, Boolean))
Get
Return _filterRule
End Get
Set(value As Expression(Of Func(Of String, String, Boolean)))
If value Is Nothing Then
Return
End If
_filterRule = value
_filterRuleCompiled = Function(item) value.Compile()(item, Text)
End Set
End Property
'''<summary>
''' Lambda-Expression to order the suggested items
''' (as Expression here because simple lamda (func) is not serializable)
''' <para>default: alphabetic ordering</para>
'''</summary>
Public Property SuggestListOrderRule() As Expression(Of Func(Of String, String))
Get
Return _suggestListOrderRule
End Get
Set(value As Expression(Of Func(Of String, String)))
If value Is Nothing Then
Return
End If
_suggestListOrderRule = value
_suggestListOrderRuleCompiled = value.Compile()
End Set
End Property
#End Region
''' <summary>
''' ctor
''' </summary>
Public Sub New()
' set the standard rules:
_filterRuleCompiled = Function(s) s.ToLower().Contains(Text.Trim().ToLower())
_suggestListOrderRuleCompiled = Function(s) s
_propertySelectorCompiled = Function(collection) collection.Cast(Of String)()
_suggLb.DataSource = _suggBindingList
AddHandler _suggLb.Click, AddressOf SuggLbOnClick
AddHandler ParentChanged, AddressOf OnParentChanged
End Sub
''' <summary>
''' the magic happens here ;-)
''' </summary>
''' <param name="e"></param>
Protected Overrides Sub OnTextChanged(e As EventArgs)
MyBase.OnTextChanged(e)
If Not Focused Then
Return
End If
_suggBindingList.Clear()
_suggBindingList.RaiseListChangedEvents = False
_propertySelectorCompiled(Items).Where(_filterRuleCompiled).OrderBy(_suggestListOrderRuleCompiled).ToList().ForEach(AddressOf _suggBindingList.Add)
_suggBindingList.RaiseListChangedEvents = True
_suggBindingList.ResetBindings()
_suggLb.Visible = _suggBindingList.Any()
If _suggBindingList.Count = 1 AndAlso _suggBindingList.[Single]().Length = Text.Trim().Length Then
Text = _suggBindingList.[Single]()
[Select](0, Text.Length)
_suggLb.Visible = False
End If
End Sub
#Region "size and position of suggest box"
''' <summary>
''' suggest-ListBox is added to parent control
''' (in ctor parent isn't already assigned)
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Overloads Sub OnParentChanged(sender As Object, e As EventArgs)
Parent.Controls.Add(_suggLb)
Parent.Controls.SetChildIndex(_suggLb, 0)
_suggLb.Top = Top + Height - 3
_suggLb.Left = Left + 3
_suggLb.Width = Width - 20
_suggLb.Font = New Font("Segoe UI", 9)
End Sub
Protected Overrides Sub OnLocationChanged(e As EventArgs)
MyBase.OnLocationChanged(e)
_suggLb.Top = Top + Height - 3
_suggLb.Left = Left + 3
End Sub
Protected Overrides Sub OnSizeChanged(e As EventArgs)
MyBase.OnSizeChanged(e)
_suggLb.Width = Width - 20
End Sub
#End Region
#Region "visibility of suggest box"
Protected Overrides Sub OnLostFocus(e As EventArgs)
' _suggLb can only getting focused by clicking (because TabStop is off)
' --> click-eventhandler 'SuggLbOnClick' is called
If Not _suggLb.Focused Then
HideSuggBox()
End If
MyBase.OnLostFocus(e)
End Sub
Private Sub SuggLbOnClick(sender As Object, eventArgs As EventArgs)
Text = _suggLb.Text
Focus()
End Sub
Private Sub HideSuggBox()
_suggLb.Visible = False
End Sub
Protected Overrides Sub OnDropDown(e As EventArgs)
HideSuggBox()
MyBase.OnDropDown(e)
End Sub
#End Region
#Region "keystroke events"
''' <summary>
''' if the suggest-ListBox is visible some keystrokes
''' should behave in a custom way
''' </summary>
''' <param name="e"></param>
Protected Overrides Sub OnPreviewKeyDown(e As PreviewKeyDownEventArgs)
If Not _suggLb.Visible Then
MyBase.OnPreviewKeyDown(e)
Return
End If
Select Case e.KeyCode
Case Keys.Down
If _suggLb.SelectedIndex < _suggBindingList.Count - 1 Then
_suggLb.SelectedIndex += 1
End If
Return
Case Keys.Up
If _suggLb.SelectedIndex > 0 Then
_suggLb.SelectedIndex -= 1
End If
Return
Case Keys.Enter
Text = _suggLb.Text
[Select](0, Text.Length)
_suggLb.Visible = False
Return
Case Keys.Escape
HideSuggBox()
Return
End Select
MyBase.OnPreviewKeyDown(e)
End Sub
Private Shared ReadOnly KeysToHandle As List(Of Keys) = New List(Of Keys) From {Keys.Down, Keys.Up, Keys.Enter, Keys.Escape}
Protected Overrides Function ProcessCmdKey(ByRef msg As Message, keyData As Keys) As Boolean
' the keysstrokes of our interest should not be processed be base class:
If _suggLb.Visible AndAlso KeysToHandle.Contains(keyData) Then
Return True
End If
Return MyBase.ProcessCmdKey(msg, keyData)
End Function
#End Region
End Class
End Namespace

How to Convert this generic method from C# to VB.Net

I have the following code block in C#
private void Synchronize<T>(TextSelection selection, DependencyProperty property, Action<T> methodToCall)
{
object value = selection. GetPropertyValue(property) ;
if ( value != DependencyProperty. UnsetValue) methodToCall((T) value) ;
}
That I have converted to VB.
Private Sub Synchronize(Of T)(ByVal selection As TextSelection, ByVal [property] As DependencyProperty, ByVal methodToCall As Action(Of T))
Dim value As Object = selection.GetPropertyValue([property])
If value IsNot DependencyProperty.UnsetValue Then
methodToCall(DirectCast(value, T))
End If
End Sub
The calling method look like:
Synchronize(Of Double)(selection, TextBlock.FontSizeProperty, AddressOf SetFontSize)
Synchronize(Of FontWeight)(selection, TextBlock.FontSizeProperty, AddressOf SetFontWeight)
Synchronize(Of FontStyle)(selection, TextBlock.FontStyleProperty, AddressOf SetFontStyle)
Synchronize(Of FontFamily)(selection, TextBlock.FontFamilyProperty, AddressOf SetFontFamily)
Synchronize(Of TextDecorationCollection)(selection, TextBlock.TextDecorationsProperty, AddressOf SetTextDecoration)
My problem is with the DirectCast call; if my delegate argument can be a simple type (integer, double, etc) or an object. DirectCast doesn't like the simple data types an InvalidCastException is thrown when I try to cast to a double. Does anyone have a suggested solution to this problem? I've also tried TryCast, but it doesn't like my (of T) and says it must be class contstrained.
Thanks all!
Ryan

Try CType() instead of DirectCast().

Looking at the errors you're seeing, it sounds like you may need to add a constraint on your T handle limit it to a class in order for the TryCast to be used.
I'm not really familiar with VB's TryCast method (or DirectCast, for that matter), but something like this might help [note that (Of T) -> (Of T as Class) ]:
Private Sub Synchronize(Of T as Class)(ByVal selection As TextSelection, ByVal [property] As DependencyProperty, ByVal methodToCall As Action(Of T))
Dim value As Object = selection.GetPropertyValue([property])
If value IsNot DependencyProperty.UnsetValue Then
methodToCall(TryCast(value, T))
End If
End Sub

Use CType instead of TryCast/DirectCast. It should work like the casting in C# :
methodToCall(CType(value, T))

You can put multiple constraints on t
I believe the syntax is something like:
Private Sub Synchronize(Of T as {Class, Integer, Double})

What is the VB equivalent of this C# syntax, dealing with delegates?

Is it possible to translate the following C# code into VB.NET, using VB 9.0?
delegate Stream StreamOpenerDelegate(String name);
void Exec1()
{
WorkMethod( x => File.OpenRead(x));
}
void Exec2()
{
StreamOpenerDelegate opener = x => return File.OpenRead(x) ;
WorkMethod(opener);
}
Can I do something like this?:
Private Delegate Function StreamOpenerDelegate(ByVal name As String) As Stream
Private Sub WorkMethod(ByVal d As StreamOpenerDelegate)
''
End Sub
Private Sub Exec1()
Me.WorkMethod(Function (ByVal x As String)
Return File.OpenRead(x)
End Function)
End Sub
Private Sub Exec2()
Dim opener As StreamOpenerDelegate = Function (ByVal x As String)
Return File.OpenRead(x)
End Function
Me.WorkMethod(opener)
End Sub
I'm trying to write some documentation, but I don't know VB syntax. Often I use Reflector to translate it, but I'm not sure it's working in this case. I'm also not clear on where I would need line continuation characters.
ANSWER
In VB9, it's not possible to have multi-line lambdas (or Sub lambdas, which I did not ask about). In VB9, all lambdas return a value, and must be a single expression. This changes in VB10. VB10 will allow the above syntax, but VB9 will not. In VB9, if the logic involves multiple code lines, it must not be a lambda; you must put it into a named Function and reference it explicitly. Like this:
Private Delegate Function StreamOpenerDelegate(ByVal name As String) As Stream
Private Sub WorkMethod(ByVal d As StreamOpenerDelegate)
''
End Sub
Function MyStreamOpener(ByVal entryName As String) As Stream
'' possibly multiple lines here
Return File.OpenRead(entryName)
End Function
Private Sub Exec1()
Me.WorkMethod(AddressOf MyStreamOpener)
End Sub
site: Mike McIntyre's blog

This should work:
Private Sub Exec1()
Me.WorkMethod(Function (x) File.OpenRead(x))
End Sub
Private Sub Exec2()
Dim opener As StreamOpenerDelegate = Function (x) File.OpenRead(x)
Me.WorkMethod(opener)
End Sub
You need the line continuation character to split a single line statement into multiple lines, like so:
Private Sub Exec1()
Me.WorkMethod(Function (x) _
File.OpenRead(x))
End Sub
Private Sub Exec2()
Dim opener As StreamOpenerDelegate = Function (x) _
File.OpenRead(x)
Me.WorkMethod(opener)
End Sub
In any case, in VS2010 there is implicit line continuation after certain characters. So I wouldn't worry about it too much.