7.1 委托

委托声明与调用的代码

 

代码
Delegate Sub DisplayMessage(ByVal msg As String)

Module Module2
Sub TestDelegate()
Dim deleg As DisplayMessage
deleg
= New DisplayMessage(AddressOf WriteToDebugWindow)
deleg.Invoke(
"FooBar")

End Sub

' Display a string in the Debug window.
Sub WriteToDebugWindow(ByVal msgText As String)
Debug.WriteLine(msgText)
End Sub

End Module

 

 

委托是一个类,可以在命名空间级别、或类的声明部分定义委托。单不能再函数内部定义委托。

委托变量的声明,实际上是实例化一个类。

委托是不可变类型,一旦创建就不能使其指向另一个方法。

 

委托调用静态方法

 

代码
Imports System.Windows.Forms

Delegate Function AskYesNoQuestion(ByVal msg As String) As Boolean
Module Module2
Sub DelegateToStaticMethod()
' A delegate variable that points to a shared function.
Dim question As New AskYesNoQuestion(AddressOf MessageDisplayer.AskYesNo)

' Call the shared method. (Note that Invoke is omitted.)
If question("Do you want to save?") Then
' Save whatever needs to be saved here.
End If
End Sub

End Module

Public Class MessageDisplayer
' Show a message box; return True if user clicks Yes.
Public Shared Function AskYesNo(ByVal msgText As String) As Boolean
' Display the message.
Dim answer As DialogResult =
MessageBox.Show(msgText,
"Ask Yes or No", MessageBoxButtons.YesNo, MessageBoxIcon.Question)

' Return True if the user answers yes.
Return (answer = MsgBoxResult.Yes)
End Function

End Class

 

 

在实例方法中使用委托

 

代码
Imports System.Windows.Forms

Module Module2
Delegate Function AskQuestion(ByVal DefaultAnswer As Boolean) As Boolean

Sub DelegateToInstanceMethod()
' Create an instance of the class, and initialize its properties.
Dim msgdisp As New MessageDisplayer()
msgdisp.MsgText
= "Do you want to save?"
msgdisp.MsgTitle
= "File has been modified"
' Create the delegate to the instance method.
' (Note the object reference in the AddressOf clause.)
Dim question As New AskQuestion(AddressOf msgdisp.YesOrNo)

' Call the instance method through the delegate.
If question(False) Then
' Save whatever needs to be saved here.
End If
End Sub

End Module

Public Class MessageDisplayer

Public MsgText As String
Public MsgTitle As String

' Display a message box, and return True if the user selects Yes.
Function YesOrNo(ByVal DefaultAnswer As Boolean) As Boolean
' Display the message.
Dim answer As DialogResult = MessageBox.Show(
MsgText, MsgTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question)
' Return True if the user answers yes.
Return (answer = MsgBoxResult.Yes)
End Function

End Class

 

 7.1.4 回调方法和代码重用

显示一个目录树中所有文件夹名称的例程

 

代码
Module Module2
Sub DisplayDirectoryTree(ByVal path As String)
For Each dirname As String In System.IO.Directory.GetDirectories(path)
Console.WriteLine(dirname)
DisplayDirectoryTree(dirname)
Next
End Sub
End Module

 

 

 使用委托重用代码

 

代码
Imports System.IO

Module Usage
Sub TestTraverseDirectoryTree()
' Print the name of all the directories under c:\WINDOWS.
TraverseDirectoryTree("C:\WINDOWS", AddressOf DisplayDirName)
End Sub

' A routine that complies with the TraverseDirectoryTreeCallback syntax
Private Sub DisplayDirName(ByVal path As String)
Console.WriteLine(path)
End Sub

End Module

Module ClassLibrary

' The delegate that defines the syntax of the function whose address
' can be passed to TraverseDirectoryTree
Delegate Sub TraverseDirectoryTreeCallback(ByVal dirName As String)

' A reusable routine that visits all the folders in a directory tree
' and calls back the caller by passing the name of each folder
Sub TraverseDirectoryTree(ByVal path As String, ByVal cbk As TraverseDirectoryTreeCallback)
For Each dirName As String In Directory.GetDirectories(path)
' Do the actual job by invoking the callback procedure.
cbk.Invoke(dirName)
' Call this routine recursively to process subfolders.
TraverseDirectoryTree(dirName, cbk)
Next
End Sub

End Module

 

 

使用委托的好处

不使用委托的代码

 

代码
Sub TestListSubfolders()
Dim dirs() As String = Directory.GetDirectories("c:\windows", "*.*", SearchOption.AllDirectories)
For Each dirName As String In dirs
' Do whatever you wish with items in the returned ArrayList.
Console.WriteLine(dirName)
Next
End Sub

 

 

使用委托的代码

 

代码
Imports System.IO

Module Usage
Sub TestCallbackMethod()
' Print the name of all the directories under c:\WINDOWS.
TraverseDirectoryTree2("C:\WINDOWS", AddressOf DisplayDirName2)
End Sub

Function DisplayDirName2(ByVal path As String) As Boolean
Console.WriteLine(path)
If path.EndsWith("\printers") Then Return True
End Function

End Module

Module ClassLibrary

' A delegate that defines the syntax of the function whose address
' can be passed to TraverseDirectoryTree2
Delegate Function TraverseDirectoryTreeCallback2(ByVal dirName As String) As Boolean

Function TraverseDirectoryTree2(ByVal path As String,
ByVal cbk As TraverseDirectoryTreeCallback2) As Boolean
For Each dirName As String In Directory.GetDirectories(path)
' Invoke the callback function; exit if it canceled enumeration.
Dim canceled As Boolean = cbk.Invoke(dirName)
If canceled Then Return True
' Call this routine recursively; exit if enumeration was canceled.
canceled = TraverseDirectoryTree2(dirName, cbk)
If canceled Then Return True
Next
End Function

End Module

 

 

 7.1.5 委托多路广播

Combine

代码
' Notice that you can have a delegate point to methods defined in the .NET Framework.
Dim cbk As New TraverseDirectoryTreeCallback(AddressOf Console.WriteLine)
Dim cbk2 As New TraverseDirectoryTreeCallback(AddressOf Debug.WriteLine)

' Combine them into a multicast delegate; assign back to first variable.
' We need this statement if Option Strict is On.
cbk = DirectCast([Delegate].Combine(cbk, cbk2), TraverseDirectoryTreeCallback)

Remove

 

cbk = DirectCast(System.Delegate.Remove(cbk, cbk2), TraverseDirectoryTreeCallback)

 

 

GetInvocationList

 

代码
' Get the list of individual delegates in a multicast delegate.
Dim delegates() As [Delegate] = cbk.GetInvocationList()
' List the names of all the target methods.
For Each d As [Delegate] In delegates
Console.WriteLine(d.Method.Name)
Next

 

 

Test

 

TraverseDirectoryTree("C:\WINDOWS", cbk)

 

 7.2 事件

7.1.1利用Handles关键字处理事件

 

Private Sub btnOK_Click(ByVal sender As Object,
ByVal e As EventArgs) Handles btnOK.Click
Me.Close()
End Sub

FirstName不允许包括空格

 

代码
Private Sub txtFirstName_KeyPress(ByVal sender As Object,
ByVal e As KeyPressEventArgs) Handles txtFirstName.KeyPress

' Ignore spaces typed by the user. (This is obtained by telling
' the .NET Framework that we handled this key.)
If e.KeyChar = " "c Then e.Handled = True

End Sub

 

Handles处理多个事件,事件之间用“,”隔开。

 

代码
'控件获得焦点后,其背景颜色变为黄色
Private Sub Control_Enter(ByVal sender As Object, ByVal e As EventArgs
)
Handles txtFirstName.Enter, txtLastName.Enter, txtCity.Enter
Dim ctrl As Control = DirectCast(sender, Control)
' Change the background color when this control gets the focus.
ctrl.BackColor = Color.Yellow
End Sub
'控件失去焦点后,其背景颜色恢复Window颜色
Private Sub Control_Leave(ByVal sender As Object, ByVal e As EventArgs
)
Handles txtFirstName.Leave, txtLastName.Leave, txtCity.Leave
Dim ctrl As Control = DirectCast(sender, Control)
' Restore the default background color when the control loses the focus.
ctrl.BackColor = SystemColors.Window
End Sub

 

7.2.2 WithEvents关键字

查看控件的声明代码,在名称前面带有WithEvents关键字

 

代码
Friend WithEvents txtFirstName As System.Windows.Forms.TextBox
Friend WithEvents txtLastName As System.Windows.Forms.TextBox
Friend WithEvents txtCity As System.Windows.Forms.TextBox
Friend WithEvents btnOK As System.Windows.Forms.Button

 

以下代码示例使用Timer对象,在给定时间毫秒后启动一个外部程序

 

代码
Public Class AppScheduler

Private WithEvents Timer As New System.Windows.Forms.Timer
Private exePath As String
Private arguments As String

Public Sub New(ByVal exePath As String, ByVal arguments As String, ByVal milliseconds As Integer)
' Remember application's path and arguments for later.
Me.exePath = exePath
Me.arguments = arguments
' Activate the timer.
Me.Timer.Interval = milliseconds
Me.Timer.Enabled = True
End Sub

Private Sub Timer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles Timer.Tick
' Prevent the timer from firing again.
Me.Timer.Enabled = False
' Run the application.
Process.Start(exePath, arguments)
End Sub
End Class

 

 

使用AppScheduler的方法

 

dim sched as new appscheduler("Notepad.exe","c:\data.txt",5000)

 

 

在分离的类中处理事件

定义TextBoxWrapper类

 

代码
Public Class TextBoxWrapper
' The control being wrapped
Private WithEvents TextBox As TextBox
' The list of valid characters
Private ValidChars As String

Public Sub New(ByVal textBox As TextBox, ByVal validChars As String)
Me.TextBox = textBox
Me.ValidChars = validChars
End Sub

Private Sub TextBox_KeyPress(ByVal sender As Object, ByVal e As KeyPressEventArgs) Handles TextBox.KeyPress
' Discard any key press not in the list of valid characters.
If ValidChars.IndexOf(e.KeyChar) < 0 Then e.Handled = True
End Sub
End Class

 

 

使用TextBoxWrapper类

 

代码
Public Class TextboxWrappersForm
Dim qtyWrapper, phoneWrapper, idWrapper As TextBoxWrapper
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As EventArgs) Handles MyBase.Load
qtyWrapper
= New TextBoxWrapper(txtQty, "0123456789")
phoneWrapper
= New TextBoxWrapper(txtPhone, "-0123456789()")
idWrapper
= New TextBoxWrapper(txtID, "0123456789ABCDEFabcdef")
End Sub
End Class

 

 

 7.2.4 AddHandler关键字

 

代码
'1)
AddHandler txtFirstName.Enter, New EventHandler(AddressOf Control_Enter)
RemoveHandler txtFirstName.Enter, New EventHandler(AddressOf Control_Enter)
'2)
AddHandler txtFirstName.Enter, AddressOf Control_Enter
RemoveHandler txtFirstName.Enter, AddressOf Control_Enter

 动态使用Timer控件的方法

 

代码
Public Class Form1
Dim timer1 As Timer
Sub task1()
AddHandler timer1.Tick, AddressOf task1_backgroundActivity
timer1.Enabled
= True

'执行任务
Application.DoEvents()
'执行任务

timer1.Enabled
= False
RemoveHandler timer1.Tick, AddressOf task1_backgroundActivity
End Sub

Sub task1_backgroundActivity(ByVal sender As Object, ByVal e As EventArgs)

End Sub

Sub task2()
AddHandler timer1.Tick, AddressOf task2_backgroundActivity
timer1.Enabled
= True

'执行任务
Application.DoEvents()
'执行任务

timer1.Enabled
= False
RemoveHandler timer1.Tick, AddressOf task2_backgroundActivity
End Sub

Sub task2_backgroundActivity(ByVal sender As Object, ByVal e As EventArgs)

End Sub
End Class

 

 

 不能指望VS来创建静态事件处理过程的主干

 

代码
Public Class StaticEventsForm
Private Sub StaticEventsForm_Load(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles Me.Load
AddHandler Application.Idle, AddressOf Application_Idle
End Sub

Sub Application_Idle(ByVal sender As Object, ByVal e As EventArgs)
lblCharCount.Text
= txtField.TextLength.ToString()
End Sub
End Class

 

 

7.2.5 捕获数组和集合事件

当鼠标移到控件之上时,在状态栏显示Tag内容

代码
Public Class ControlArrayForm
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
' Registers two events for each control on the Form.
For Each ctrl As Control In GetChildControls(Me)
AddHandler ctrl.MouseEnter, AddressOf Control_MouseEnter
AddHandler ctrl.MouseLeave, AddressOf Control_MouseLeave
Next
End Sub

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
' Unregisters the events for all the controls on the Form.
For Each ctrl As Control In GetChildControls(Me)
RemoveHandler ctrl.MouseEnter, AddressOf Control_MouseEnter
RemoveHandler ctrl.MouseLeave, AddressOf Control_MouseLeave
Next
End Sub

Private Sub Control_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim ctrl As Control = DirectCast(sender, Control)
If Not ctrl.Tag Is Nothing Then ToolStripStatusLabel1.Text = ctrl.Tag.ToString()
End Sub

Private Sub Control_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)
ToolStripStatusLabel1.Text
= ""
End Sub

' Return the list of all the controls contained in another control.
Function GetChildControls(ByVal parent As Control) As ArrayList
Dim result As New ArrayList()
For Each ctrl As Control In parent.Controls
' Add this control to the result.
result.Add(ctrl)
' Recursively call this method to add all child controls as well.
result.AddRange(GetChildControls(ctrl))
Next
Return result
End Function
End Class

 

 7.2.6在自己的类中声明事件

 

代码
Public Class User
' Define the event.
Public Event NameChanged(ByVal sender As Object, ByVal e As EventArgs)

Private m_Name As String

Public Property Name() As String
Get
Return m_Name
End Get
Set(ByVal value As String)
If m_Name <> value Then
m_Name
= value
' Raise the NameChanged event (only if the property has actually changed).
RaiseEvent NameChanged(Me, EventArgs.Empty)
End If
End Set
End Property
End Class

 

 

使用User类

 

代码
Class userUsage
Dim WithEvents user As New User
Sub testNameChangeEvent()
user.Name
= "joe"
End Sub
Sub user_nameChanged(ByVal sender As Object, ByVal e As EventArgs) Handles user.NameChanged
Console.WriteLine(
"Name property has changed")
End Sub
End Class

 

 

改变User类中的事件声明,以提高性能

 

public event NameChanged as EventHandler

 

 

7.2.7事件语法的准则

用.net已有的事件定义类事件

代码
Imports System.ComponentModel

Public Class User
Public Event BeforeLogin As CancelEventHandler
Public Event AfterLogin As EventHandler

Public Sub Login()
' Ask clients whether logging in is OK.
Dim e As New CancelEventArgs()
RaiseEvent BeforeLogin(Me, e)
If e.Cancel Then Exit Sub

' Perform the login here...

' Let clients know that the user has logged in.
RaiseEvent AfterLogin(Me, EventArgs.Empty)
End Sub
End Class

用自定义类定义一个新事件

 

代码
Public Class NameChangingEventArgs
Inherits CancelEventArgs

Public Sub New(ByVal proposedValue As String)
m_ProposedValue
= proposedValue
End Sub

Private m_ProposedValue As String

Public ReadOnly Property ProposedValue() As String
Get
Return m_ProposedValue
End Get
End Property
End Class

' The delegate that defines the event
Public Delegate Sub NameChangingEventHandler(ByVal sender As Object, ByVal e As NameChangingEventArgs)

 

 

修改User类以便使用自定义类

 

代码
Public Class User
Public Event NameChanging As NameChangingEventHandler
Public Event NameChanged(ByVal sender As Object, ByVal e As EventArgs)

Private m_Name As String

Public Property Name() As String
Get
Return m_Name
End Get
Set(ByVal value As String)
If m_Name <> value Then
' Ask clients whether it's OK to assign the new value.
Dim e As New NameChangingEventArgs(value)
RaiseEvent NameChanging(Me
, e)
If e.Cancel Then Exit Property

' Proceed with assignment.
m_Name = value
' Raise the NameChanged event (only if the property has actually changed).
RaiseEvent NameChanged(Me, EventArgs.Empty)
End If
End Set
End Property

End Class

 

NameChanging的用法:

 

代码
Class userUsage
Dim WithEvents user As New User

Private Sub User_NameChanging(ByVal sender As Object,
ByVal e As NameChangingEventArgs) Handles user.NameChanging
' Accept only names that contain alphabetical characters; reject all others.
If e.ProposedValue Like "*[!A-Za-z]*" Then e.Cancel = True
End Sub
End Class