VB.Net/Language Basics/Delegate

Delegate Demo for a Simple Class

 
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

Delegate Syntax

  
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

Delegate with and without parameters

 
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

Function Delegate: output string

 
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

Function Delegation Demo

 
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

Multicast Delegate

 
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

Register Delegates and call them

 
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

Simple Delegate Demo

 
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

Sort Delegate

 
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

Two ways to init a Delegate

 
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

Use Delegate to implement custome sort

 
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