# End 语句应用方案

## 知识概述

结束一个过程或块。

语法

End

End Function

End If

End Property

End Select

End Sub

End Type

End With

End 语句中各部分说明如表 1 所示。

表 1 End 语句中的各部分的说明

部 分 | 描 述
End | 停止执行。不是必要的，可以放在过程中的任何位置来关闭代码执行、关闭以 Open 语句打开的文件并清除变量
End Function | 必要的，用于结束一个 Function 语句
End If | 必要的，用于结束一个 If…Then…Else 语句块
End Property | 必要的，用于结束一个 Property Let、Property Get 或 Property Set 过程
End Select | 必要的，用于结束一个 Select…Case 语句
End Sub | 必要的，用于结束一个 Sub 语句
End Type | 必要的，用于结束一个用户定义类型的定义（Type 语句）
End With | 必要的，用于结束一个 With 语句

End 语句会重置所有模块级别变量和所有模块的静态局部变量。End 语句不调用 Unload、QueryUnload、或 Terminate 事件或任何其它 Visual Basic 6.0 代码，只是生硬地终止代码执行。类模块创建的对象被破坏，由 Open 语句打开的文件被关闭，并且释放程序所占用的内存。其它程序的对象引用无效。

End 语句提供了一种强迫中止程序的方法。Visual Basic 6.0 程序正常结束应该卸载所有的窗体。只要没有其它程序引用该程序公共类模块创建的对象并无代码执行，程序将立即关闭。

示例

本示例使用 End 语句结束 With 语句。

With Adodc2.Recordset

If .Fields(0) <> "" Then Labpz.Caption = .Fields(0) Else Labpz.Caption = 0

If .Fields(1) <> "" Then Labsl.Caption = .Fields(1) Else Labsl.Caption = 0

End With

本示例使用 End 语句，在用户输入错误密码时结束代码执行，如图 20.9～20.11 所示。

图 1 输入密码提示框

图 2 密码输入错误提示框

图 3 成功进入主窗体

完整程序代码如下：

Sub Form_Load()

Dim Password, Pword

Password = "111" '111 为进入密码

Pword = InputBox("请输入密码")

If Pword <> Password Then

MsgBox "对不起你输入的密码错误。"

End

End If

End Sub

注意：End 语句不调用 Unload、QueryUnload、Terminate 事件或任何其他 VB 代码，只是一味地终止代码执行。窗体和类模块中的Unload、QueryUnload和Terminate事件代码未被执行。类模块创建的对象被破坏，由Open语句打开的文件被关闭，并且释放程序所占用的内存。其他程序的对象引用无效。

## 应用一：结束应用程序

本例分别使用 End 语句与 Unload 语句关闭程序和窗体。在使用 End 语句关闭程序时，窗体不发生 Unload 事件而直接被关闭。在使用 Unload 语句关闭窗体时，窗体发生 Unload 事件，调用对话框选择是否退出程序。如图 1 所示。

图 1 关闭程序和窗体

程序完整代码如下：

Private Sub Command1_Click()

End

End Sub

Private Sub Command2_Click()

Unload Form1

End Sub

Private Sub Form_Unload(Cancel As Integer)

If MsgBox("是否退出？", vbYesNo, "提示") = vbNo Then Cancel = 1

End Sub

说明：窗体 Unload 事件中的 Cancel 参数是一个整数，决定了窗体是否被关闭。只要 Cancel参数值不为0，窗体就不会被关闭。

## 应用二：结束 Function 过程

本例利用 Function 过程来计算阶乘，使用 End Function 语句结束 Function 过程如在下面的程序当中，在文本框中输入一个数值后，单击“求阶乘”按钮就可求出该数值的阶乘，如图 1 所示。

图 1 Function 过程的应用

#### 程序的相关代码如下：

Public Function Fact(ByRef n As Integer) As Long

If n = 0 Then

Fact = 1

Else

Fact = n * Fact(n - 1)

End If

End Function

#### 程序完整代码如下：

Private Sub Command1_Click()

Dim m As Long

Dim n As Integer

n = Val(Text1.Text)

m = Fact(n)

Text2.Text = Str$(m)

End Sub

Public Function Fact(ByRef n As Integer) As Long

If n = 0 Then

Fact = 1

Else

Fact = n * Fact(n - 1)

End If

End Function

Private Sub Command2_Click()

Unload Me

End Sub

## 应用三：查找指定报文文件

在大型的实践工程当中，经常会用到查找文件的功能。如在军事文件管理系统当中，经常需要查找报文文件或其他文本文件，如图 1 查找报文文件界面中，选择响应的文件夹并且输入要查找的文件类型后，单击“查找”按钮，在 ListBox 控件中就可以显示查找到的所有结果。

图 1 查找报文文件

程序中自定义查找的过程函数代码如下：

'查找文件的过程函数

Public Function Autosearchfiles(ByVal sDirName As String, ByVal FileFilter As String, lstFilesFound As ListBox) As Boolean

On Error GoTo RF_ERROR

Dim sName, sFile, sExt As String

Dim sDirlist() As String, iDirNum As String, i As Integer

'首先找出该目录下的所有文件

sFile = Dir(sDirName + FileFilter, vbNormal Or vbArchive Or vbHidden)

Do While Len(sFile) > 0

sFile = UCase(Trim(sFile))

'将 sFile 加入到 List 控件当中

lstFilesFound.AddItem sDirName & sFile

List1.Refresh

sFile = Dir

Loop

'准备遍历全部子目录

iDirNum = 0

sName = Dir(sDirName + "*.*", vbDirectory Or vbNormal)

Do While Len(sName) > 0

If sName <> "." And sName <> ".." Then

iDirNum = iDirNum + 1

ReDim Preserve sDirlist(1 To iDirNum)

sDirlist(iDirNum) = sDirName + sName + "\"

End If

sName = Dir

Loop

For i = 1 To iDirNum

List1.Refresh

Autosearchfiles sDirlist(i), FileFilter, lstFilesFound

Next i

RF_EXIT:

Autosearchfiles = True

Exit Function

RF_ERROR:

Resume RF_EXIT

End Function

程序完整代码如下：

Private Sub Command2_Click()

frm_copy.Show

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Command1_Click()

If Text1.Text = "" Then

MsgBox "输入不能为空值"

Else

MousePointer = vbHourglass

DoEvents

List1.Clear

Label1.Caption = "正在查找......"

Autosearchfiles Dir1.Path, Text1.Text, List1

MousePointer = vbDefault

End If

Label1.Caption = "当前查找到的文件总数为：" & List1.ListCount & "个"

End Sub

Private Sub Drive1_Change()

On Error Resume Next '错误处理语句

Dir1.Path = Drive1.Drive

End Sub

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = (Screen.Height - Me.Height) / 2

Drive1.Drive = "c:\"

Dir1.Path = "c:\"

End Sub

'查找文件的过程函数

Public Function Autosearchfiles(ByVal sDirName As String, ByVal FileFilter As String, lstFilesFound As ListBox) As Boolean

On Error GoTo RF_ERROR

Dim sName, sFile, sExt As String

Dim sDirlist() As String, iDirNum As String, i As Integer

'首先找出该目录下的所有文件

sFile = Dir(sDirName + FileFilter, vbNormal Or vbArchive Or vbHidden)

Do While Len(sFile) > 0

sFile = UCase(Trim(sFile))

'将 sFile 加入到 List 控件当中

lstFilesFound.AddItem sDirName & sFile

List1.Refresh

sFile = Dir

Loop

'准备遍历全部子目录

iDirNum = 0

sName = Dir(sDirName + "*.*", vbDirectory Or vbNormal)

Do While Len(sName) > 0

If sName <> "." And sName <> ".." Then

iDirNum = iDirNum + 1

ReDim Preserve sDirlist(1 To iDirNum)

sDirlist(iDirNum) = sDirName + sName + "\"

End If

sName = Dir

Loop

For i = 1 To iDirNum

List1.Refresh

Autosearchfiles sDirlist(i), FileFilter, lstFilesFound

Next

RF_EXIT:

Autosearchfiles = True

Exit Function

RF_ERROR:

Resume RF_EXIT

End Function

## 应用四：提取汉字的首字母

为了方便查询，许多程序都提供了按拼音首字母查询汉字信息的方式。例如汉字“明日科技”可通过拼音“MRKJ”查询。实现这种查询的前提是提取汉字拼音首字母。通过下例编写的自定义函数，可以提取汉字的首字母。程序运行如图 1 所示。

程序开发步骤如下。

（1）创建“标准 EXE”工程。

（2）在窗体中添加 TextBox（文本框）控件。

（3）窗体中添加两个 Label（标签）控件，将 Label1 的 Caption 属性设置为空，Label2 的 Caption 属性设置为“显示：”。

图 1 获取汉字首字母

（4）添加 CommandButton（按钮）控件，设置其 Caption 属性为“退出”。

（5）程序完整代码如下：

Public Function py(mystr As String) As String

If Asc(mystr) < 0 Then

If Asc(Left(mystr, 1)) < Asc("啊") Then

py = "0"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then

py = "A"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then

py = "B"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then

py = "C"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then

py = "D"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then

py = "E"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then

py = "F"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then

py = "G"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then

py = "H"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then

py = "J"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then

py = "K"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then

py = "L"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then

py = "M"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then

py = "N"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then

py = "O"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then

py = "P"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then

py = "Q"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then

py = "R"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then

py = "S"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then

py = "T"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then

py = "W"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then

py = "X"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then

py = "Y"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("匝") Then

py = "Z"

Exit Function

End If

Else

If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then

py = UCase(Left(mystr, 1))

Else

py = mystr

End If

End If

End Function

Private Sub Form_Load()

Command1_Click

End Sub

Private Sub Text1_Change()

Command1_Click

End Sub

Private Sub Command1_Click()

Dim a As Integer

Label1.Caption = ""

a = Len(Text1.Text)

For i = 1 To a

Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))

Next i

End Sub

Private Sub Command2_Click()

End

End Sub

## 应用五：文字旋转特效

在 VB 中利用 API 可以实现许多以前无法实现的效果，下面介绍在 VB 中实现如图所示的文字旋转的特殊效果。首先在工程中创建一个名为 MyFont 的类模块，其中的关键代码参见本书附带光盘。添加一个新窗体，在窗体上添加一个 PictureBox 和两个按钮，并添加下面的代码。运行程序，单击“执行”按钮，即可实现文字旋转的效果。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Option Explicit

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Const TA_LEFT = 0

Private Const TA_RIGHT = 2

Private Const TA_CENTER = 6

Private Const TA_TOP = 0

Private Const TA_BOTTOM = 8

Private Const TA_BASELINE = 24

Private Type LOGFONT

lfHeight As Long

lfWidth As Long

lfEscapement As Long

lfOrientation As Long

lfWeight As Long

lfItalic As Byte

lfUnderline As Byte

lfStrikeOut As Byte

lfCharSet As Byte

lfOutPrecision As Byte

lfClipPrecision As Byte

lfQuality As Byte

lfPitchAndFamily As Byte

lfFaceName As String * 50

End Type

Private m_LF As LOGFONT

Private NewFont As Long

Private OrgFont As Long

Public Sub SelOrg(o As Object)

Dim Throw As Long

NewFont = SelectObject(o.hdc, OrgFont)

Throw = DeleteObject(NewFont)

End Sub

Public Sub SelFont(o As Object)

NewFont = CreateFontIndirect(m_LF)

OrgFont = SelectObject(o.hdc, NewFont)

End Sub

Public Sub FontOut(text$, o As Control, XX, YY)

Dim Throw As Long

Throw = TextOut(o.hdc, XX, YY, text$, Len(text$))

End Sub

Public Property Get Escapement() As Long

Escapement = m_LF.lfEscapement

End Property

Public Property Let Escapement(ByVal vNewValue As Long)

m_LF.lfEscapement = vNewValue

End Property

Private Sub Class_Initialize()

m_LF.lfHeight = 30

m_LF.lfWidth = 10

m_LF.lfEscapement = 0

m_LF.lfWeight = 400

m_LF.lfItalic = 0

m_LF.lfUnderline = 0

m_LF.lfStrikeOut = 0

m_LF.lfOutPrecision = 0

m_LF.lfClipPrecision = 0

m_LF.lfQuality = 0

m_LF.lfPitchAndFamily = 0

m_LF.lfCharSet = 0

m_LF.lfFaceName = "Arial" + Chr(0)

End Sub

## 应用六：结束 Select 语句

Select Case 语句的结构与 If…then 语句有类似的结构，但是 Select Case 语句主要应用在多选一或者多选多的情况下。本示例是在窗体中建立一个按钮控件的数组，使用 Select Case 语句对按钮的事件进行编辑，如图 1 和图 2 所示。

图 1 运行程序

图 2 按钮数组发生 Click 事件

实现代码如下：

Private Sub Command1_Click(Index As Integer)

Dim i As Integer

Select Case Index

Case 0

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(0).Caption = "我是按钮 1"

Case 1

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(1).Caption = "我是按钮 2"

Case 2

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(2).Caption = "我是按钮 3"

Case 3

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(3).Caption = "我是按钮 4"

Case 4

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(4).Caption = "我是按钮 5"

Case 5

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(5).Caption = "我是按钮 6"

Case 6

For i = 0 To 6

Command1.Item(i).Caption = "Command1"

Next i

Command1.Item(6).Caption = "我是按钮 7"

End Select

End Sub

注意：Select Case 语句也可以是嵌套的。但每个嵌套的 Select Case 语句必须要有相应的 End Select 语句。

## 应用七：遍历系统进程

遍历系统进程可以通过 API 函数，将进程载入到进程结构当中，在该结构当中记录了进程的一些信息。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Option Explicit

'声明操作进程的 API

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Const MAX_PATH = 260

Const TH32CS_SNAPHEAPLIST = &H1

Const TH32CS_SNAPPROCESS = &H2

Const TH32CS_SNAPTHREAD = &H4

Const TH32CS_SNAPMODULE = &H8

Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)

'进程控制类型

Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String * MAX_PATH

End Type

Private Sub Form_Load()

Dim Pro32 As PROCESSENTRY32

Dim ProShot As Long, I As Long

ProShot = CreateToolhelpSnapshot(TH32CS_SNAPALL, 0) '获得进程“快照”的句柄

Pro32.dwSize = Len(Pro32)

I = ProcessFirst(ProShot, Pro32) '获取一个进程获取返回值

While I <> 0 '判断返回值，当返回值非零时获取下一个进程

I = ProcessNext(ProShot, Pro32)

If I = 0 Then

Exit Sub

End If

List1.AddItem Pro32.szExeFile '向 ListBox 控件中添加遍历到的系统进程

Pro32.szExeFile = ""

Wend

## 应用八：结束 End With 语句

在改变 CommonDialog 控件的多个属性时，可以在 With 控制结构中加上属性的赋值语句，这时候只是引用一次对象而不是在每个属性赋值时都要引用它，运行结果如图 1 所示。

图 1 运行结果

其完整程序代码如下：

Private Sub Command1_Click()

With CommonDialog1

'设置初始化文件目录

.InitDir = App.Path & "\相片"

.Filter = "Picture(*.bmp)|*.bmp"

'设置缺省的文件扩展名

.DefaultExt = ".bmp"

'对话框标题栏所显示的字符串

.DialogTitle = "打开 BMP 图片(职员相片)"

'打开

.ShowOpen

photoFilename = .FileName

End With

End Sub

注意：程序一旦进入 With 块，对象就不能改变，因此不能用一个 With 语句来设置多个不同的对象。可以将一个 With 块放在另一个之中，而产生嵌套的 With 语句。但是，由于外层 With 块成员会在内层的 With 块中被隐蔽住，所以必须在内层的 With 块中使用完整的对象引用来指出外层的 With 块中的对象成员。