VB.Net/Language Basics/Delegate

Delegate Demo for a Simple Class

<source lang="vbnet"> Imports System Imports System.Diagnostics Public Class MainClass

   Private Delegate Function NumEmployeesDelegate() As Integer
   Shared Sub Main()
       Dim emp As New Employee("Rod", "Stephens")
       Dim show_num As NumEmployeesDelegate
   
       show_num = AddressOf Employee.GetNumEmployees
       Console.WriteLine(show_num().ToString)

   End Sub

End Class

Public Class Employee

   " In a real application, this would return 
   " some sort of array or collection"s size.
   Public Shared Function GetNumEmployees() As Integer
       Return 13
   End Function
   " The Employee"s first name.
   Private m_FirstName As String = "<first name>"
   Public Property FirstName() As String
       Get
           Return m_FirstName
       End Get
       Set(ByVal value As String)
           m_FirstName = value
       End Set
   End Property
   " The Employee"s last name.
   Private m_LastName As String = ""
   Public Property LastName() As String
       Get
           Return m_LastName
       End Get
       Set(ByVal value As String)
           m_LastName = value
       End Set
   End Property
   Public Sub New(ByVal first_name As String, ByVal last_name As String)
       m_FirstName = first_name
       m_LastName = last_name
   End Sub
   Public Overrides Function ToString() As String
       Return m_FirstName & " " & m_LastName
   End Function

End Class

 </source>

Delegate Syntax

<source lang="vbnet"> Option Strict On Imports System.Collections.Generic Module Program

   Sub Main()
       Dim list As New List(Of Integer)()
       list.AddRange(New Integer() {20, 1, 4, 8, 9, 44})
       Dim callback As New Predicate(Of Integer)(AddressOf IsEvenNumber)
       Dim evenNumbers As List(Of Integer) = list.FindAll(callback)
       For Each evenNumber As Integer In evenNumbers
           Console.WriteLine(evenNumber)
       Next
   End Sub
   Function IsEvenNumber(ByVal i As Integer) As Boolean
       Return (i Mod 2) = 0
   End Function

End Module

 </source>

Delegate with and without parameters

<source lang="vbnet"> Imports System Imports System.Collections

Delegate Sub DelegateWithStringSignature(ByVal S As String) Delegate Sub DelegateWithNoParam() public class MainClass

  Shared Sub Main()
       Dim c As New CalledClass()
       Dim o As New OtherCalledClass()
       Dim BadObject As New ObjectWithNoWriteMessage()
       Dim d1 As DelegateWithStringSignature
       Dim Params() As Object = {"DynamicParam"}
       " The two following lines are identical
       d1 = New DelegateWithStringSignature(AddressOf c.WriteMessage)
       d1.Invoke("Test")
       d1.DynamicInvoke(Params)
       d1 = AddressOf c.WriteMessage
       d1.Invoke("Test")
       d1.DynamicInvoke(Params)
  End Sub

End Class Class CalledClass

   Shared Sub SharedMessage(ByVal s As String)
       Console.WriteLine("CalledClass.SharedMessage with parameter: " & s)
   End Sub
   Public Sub WriteMessage(ByVal s As String)
       Console.WriteLine("CalledClass WriteMessage method with parameter: " & s)
   End Sub

End Class Class OtherCalledClass

   Sub WriteMessage(ByVal s As String)
       Console.WriteLine("OtherCalledClass WriteMessage method with parameter: " & s)
   End Sub

End Class Class ObjectWithNoWriteMessage

   Sub BadWriteMessage()
   End Sub

End Class

 </source>

Function Delegate: output string

<source lang="vbnet"> Imports System Public Class MainClass

   " delegate to be a pointer to a subroutine
   " that has a string parameter.
   Private Delegate Sub StringDisplayerType(ByVal str As String)
   Shared Sub Main(ByVal args As String())
       Dim m_DisplayStringRoutine As StringDisplayerType
       " Assign the variable to a subroutine.
       m_DisplayStringRoutine = AddressOf ShowStringInMessageBox 
       " Invoke the delegate"s subroutine.
       m_DisplayStringRoutine("Hello world")
       
       m_DisplayStringRoutine = AddressOf ShowStringInOutputWindow
       " Invoke the delegate"s subroutine.
       m_DisplayStringRoutine("Hello world")
       
   End Sub
   Shared Private Sub ShowStringInOutputWindow(ByVal str As String)
       Console.WriteLine(str)
   End Sub
   Shared Private Sub ShowStringInMessageBox(ByVal str As String)
       Console.WriteLine(str)
   End Sub

End Class

 </source>

Function Delegation Demo

<source lang="vbnet"> Imports System Public Class MainClass

   Dim emp As New Employee("First Name", "Last Name")
   Private Delegate Function NumEmployeesDelegate() As Integer
   Shared Sub Main(ByVal args As String())
       Dim show_num As NumEmployeesDelegate
       show_num = AddressOf Employee.GetNumEmployees
       
       Console.WriteLine(show_num().ToString)
   End Sub

End Class

Public Class Employee

   Private m_FirstName As String
   Private m_LastName As String
   Private Shared m_NumEmployees As Integer = 0
   Public Shared Function GetNumEmployees() As Integer
       Return m_NumEmployees
   End Function
   Public Sub New(ByVal first_name As String, ByVal last_name As String)
       m_FirstName = first_name
       m_LastName = last_name
       m_NumEmployees += 1
   End Sub
   Public Overrides Function ToString() As String
       Return m_FirstName & " " & m_LastName
   End Function
   Private disposedValue As Boolean = False        " To detect redundant calls

End Class

 </source>

Multicast Delegate

<source lang="vbnet"> Imports System Public Class MainClass

   Shared Sub Main(  )
            Dim Writer, Logger As _
               MyClassWithDelegate.StringDelegate
            Dim myMulticastDelegate As MyClassWithDelegate.StringDelegate
            Writer = New MyClassWithDelegate.StringDelegate( _
                 AddressOf MyImplementingClass.WriteString)
            Logger = New MyClassWithDelegate.StringDelegate( _
                 AddressOf MyImplementingClass.LogString)
            Dim arr(  ) As MyClassWithDelegate.StringDelegate = _
               {Writer, Logger}
            Writer("String passed to Writer" & vbCrLf)
            Logger("String passed to Logger" & vbCrLf)
            Console.WriteLine(vbCrLf & "myMulticastDelegate = " + _
               "Writer and Logger")
            myMulticastDelegate = _
              DirectCast(System.Delegate.rubine(arr), _
                MyClassWithDelegate.StringDelegate)
            myMulticastDelegate("First string passed to Collector")
            Console.WriteLine(vbCrLf & _
               "myMulticastDelegate Adds Transmitter")

            Console.WriteLine(vbCrLf & "myMulticastDelegate -= Logger")
            myMulticastDelegate = _
               DirectCast(System.Delegate.Remove(myMulticastDelegate, _
                  Logger),  MyClassWithDelegate.StringDelegate)
            myMulticastDelegate("Third string passed to Collector")
   
   End Sub "Main
  

End Class

    Public Class MyClassWithDelegate
        Public Delegate Sub StringDelegate(ByVal s As String)
    End Class
    Public Class MyImplementingClass
        Public Shared Sub WriteString(ByVal s As String)
            Console.WriteLine("Writing string {0}", s)
        End Sub
        Public Shared Sub LogString(ByVal s As String)
            Console.WriteLine("Logging string {0}", s)
        End Sub
    End Class
          
        
 </source>

Register Delegates and call them

<source lang="vbnet"> Imports System Public Class MainClass

   Public Delegate Sub CallBackFunc()
   Private Shared m_cbFunc As CallBackFunc
   Public Shared Sub Main()
       RegisterDelegate(AddressOf CallBackHandler1)
       RegisterDelegate(AddressOf CallBackHandler2)
       CallDelegates()
   End Sub
   Shared Public Sub CallBackHandler1()
       Console.WriteLine("Callback 1 returned ")
   End Sub
   Shared Public Sub CallBackHandler2()
       Console.WriteLine("Callback 2 returned ")
   End Sub
   Shared Public Sub RegisterDelegate(ByRef cbFunc As CallBackFunc)
       m_cbFunc = CType(System.Delegate.rubine(m_cbFunc, cbFunc), CallBackFunc)
   End Sub
 
   Shared Public Sub CallDelegates()
       m_cbFunc()
   End Sub

End Class

 </source>

Simple Delegate Demo

<source lang="vbnet"> Imports System Public Class MainClass

   Public Delegate Sub StringSubDelegate(ByVal aString As String)
   Shared Sub Main()
       Dim test As New ClassForStringSubDelegate()
       Dim aDelegate As StringSubDelegate
       aDelegate = AddressOf test.TestSub
       aDelegate("Hello")

       aDelegate = AddressOf test.TestMsgBox
       aDelegate("Hello")

   End Sub

End Class Public Class ClassForStringSubDelegate

   Public Sub TestSub(ByVal aString As String)
       Console.WriteLine(aString & aString)
   End Sub
   Public Sub TestMsgBox(ByVal aString As String)
       Console.WriteLine("I am in a Message Box" & aString)
   End Sub

End Class

 </source>

Sort Delegate

<source lang="vbnet"> Imports System Public Class MainClass

  Shared Dim mBubbleSort As New CDelegateBubbleSort()
  Shared Dim mElementArray As Integer() = New Integer(9) {}
   
   Shared Sub Main(ByVal args As String())
     Dim randomNumber As Random = New Random()
     Dim i As Integer
     Console.WriteLine("Init Value:")
     " create String with 10 random numbers
     For i = 0 To mElementArray.GetUpperBound(0)
        mElementArray(i) = randomNumber.Next(100)
        Console.WriteLine( mElementArray(i) )
     Next
     mBubbleSort.SortArray(mElementArray, AddressOf SortAscending)
     Console.WriteLine("Sort Ascending")
     For i = 0 To mElementArray.GetUpperBound(0)
        Console.WriteLine( mElementArray(i) )
     Next
     mBubbleSort.SortArray(mElementArray, AddressOf SortDescending)
     Console.WriteLine("Sort Descending")
     For i = 0 To mElementArray.GetUpperBound(0)
        Console.WriteLine( mElementArray(i) )
     Next
   End Sub

  " delegate implementation sorts in asending order
  Shared Private Function SortAscending(ByVal element1 As Integer, _
     ByVal element2 As Integer) As Boolean
     Return element1 > element2
  End Function " SortAscending
  " delegate implementation sorts in descending order
  Shared Private Function SortDescending(ByVal element1 As Integer, _
     ByVal element2 As Integer) As Boolean
     Return element1 < element2
  End Function " SortDescending

End Class

Public Class CDelegateBubbleSort

  Public Delegate Function Comparator( _
     ByVal element1 As Integer, _
     ByVal element2 As Integer) As Boolean
  Public Sub SortArray(ByVal array As Integer(), _
     ByVal Compare As Comparator)
     Dim i, pass As Integer
     For pass = 0 To array.GetUpperBound(0)
        For i = 0 To array.GetUpperBound(0) - 1
           If Compare(array(i), array(i + 1)) Then
              Swap(array(i), array(i + 1))
           End If
        Next
     Next
  End Sub
  Private Sub Swap(ByRef firstElement As Integer, _
     ByRef secondElement As Integer)
     Dim hold As Integer
     hold = firstElement
     firstElement = secondElement
     secondElement = hold
  End Sub " Swap

End Class

 </source>

Two ways to init a Delegate

<source lang="vbnet"> Imports System Imports System.Collections

Delegate Sub DelegateWithStringSignature(ByVal S As String) Delegate Sub DelegateWithNoParam() public class MainClass

  Shared Sub Main()
       Dim c As New CalledClass()
       Dim o As New OtherCalledClass()
       Dim BadObject As New ObjectWithNoWriteMessage()
       Dim d1 As DelegateWithStringSignature
       Dim Params() As Object = {"DynamicParam"}
       " The two following lines are identical
       d1 = New DelegateWithStringSignature(AddressOf c.WriteMessage)
       d1.Invoke("Test")
       d1.DynamicInvoke(Params)
       d1 = AddressOf c.WriteMessage
       d1.Invoke("Test")
       d1.DynamicInvoke(Params)
  End Sub

End Class Class CalledClass

   Shared Sub SharedMessage(ByVal s As String)
       Console.WriteLine("CalledClass.SharedMessage with parameter: " & s)
   End Sub
   Public Sub WriteMessage(ByVal s As String)
       Console.WriteLine("CalledClass WriteMessage method with parameter: " & s)
   End Sub

End Class Class OtherCalledClass

   Sub WriteMessage(ByVal s As String)
       Console.WriteLine("OtherCalledClass WriteMessage method with parameter: " & s)
   End Sub

End Class Class ObjectWithNoWriteMessage

   Sub BadWriteMessage()
   End Sub

End Class

 </source>

Use Delegate to implement custome sort

<source lang="vbnet"> Imports System Public Class MainClass

   Shared Sub Main(  )
            Dim Student1 As New Student("Student1")
            Dim Student2 As New Student("Student2")
            Dim Employee1 As New Employee(65)
            Dim Employee2 As New Employee(12)
            Dim studentPair As New Pair(Student1, Student2)
            Dim employeePair As New Pair(Employee1, Employee2)
            Console.WriteLine("studentPair: {0}", _
                studentPair.ToString(  ))
            Console.WriteLine("employeePair: {0}", _
                employeePair.ToString(  ))
            Dim theStudentDelegate As New _
              Pair.WhichIsSmaller(AddressOf Student.WhichStudentIsSmaller)
            Dim theEmployeeDelegate As New _
              Pair.WhichIsSmaller(AddressOf Employee.WhichEmployeeIsSmaller)
            studentPair.Sort(theStudentDelegate)
            Console.WriteLine("After Sort studentPair: {0}", _
                studentPair.ToString(  ))
            studentPair.ReverseSort(theStudentDelegate)
            Console.WriteLine("After ReverseSort studentPair: {0}", _
                studentPair.ToString(  ))
            employeePair.Sort(theEmployeeDelegate)
            Console.WriteLine("After Sort employeePair: {0}", _
                employeePair.ToString(  ))
            employeePair.ReverseSort(theEmployeeDelegate)
            Console.WriteLine("After ReverseSort employeePair: {0}", _
                employeePair.ToString(  ))
   
   End Sub "Main
  

End Class

    Public Enum Comparison
        theFirst = 1
        theSecond = 2
    End Enum
    Public Class Pair
        Private thePair(2) As Object
        Public Delegate Function WhichIsSmaller(ByVal obj1 As Object, ByVal obj2 As Object) As Comparison
        Public Sub New(ByVal firstObject As Object,ByVal secondObject As Object)
            thePair(0) = firstObject
            thePair(1) = secondObject
        End Sub
        Public Sub Sort(ByVal theDelegatedFunc As WhichIsSmaller)
            If theDelegatedFunc(thePair(0), thePair(1)) = _
               Comparison.theSecond Then
                Dim temp As Object = thePair(0)
                thePair(0) = thePair(1)
                thePair(1) = temp
            End If
        End Sub
        Public Sub ReverseSort(ByVal theDelegatedFunc As WhichIsSmaller)
            If theDelegatedFunc(thePair(0), thePair(1)) = _
                   Comparison.theFirst Then
                Dim temp As Object = thePair(0)
                thePair(0) = thePair(1)
                thePair(1) = temp
            End If
        End Sub
        Public Overrides Function ToString(  ) As String
            Return thePair(0).ToString(  ) & ", " & thePair(1).ToString(  )
        End Function
    End Class
    Public Class Employee
        Private weight As Integer
        Public Sub New(ByVal weight As Integer)
            Me.weight = weight
        End Sub
        Public Shared Function WhichEmployeeIsSmaller(ByVal o1 As Object, ByVal o2 As Object) As Comparison
            Dim d1 As Employee = DirectCast(o1, Employee)
            Dim d2 As Employee = DirectCast(o2, Employee)
            If d1.weight > d2.weight Then
                Return Comparison.theSecond
            Else
                Return Comparison.theFirst
            End If
        End Function
        Public Overrides Function ToString(  ) As String
            Return weight.ToString(  )
        End Function
    End Class
    Public Class Student
        Private name As String
        Public Sub New(ByVal name As String)
            Me.name = name
        End Sub
        Public Shared Function WhichStudentIsSmaller( _
          ByVal o1 As Object, ByVal o2 As Object) As Comparison
            Dim s1 As Student = DirectCast(o1, Student)
            Dim s2 As Student = DirectCast(o2, Student)
            If String.rupare(s1.name, s2.name) < 0 Then
                Return Comparison.theFirst
            Else
                Return Comparison.theSecond
            End If
        End Function
        Public Overrides Function ToString(  ) As String
            Return name
        End Function
    End Class

 </source>