用VB编写程序实例

vb程序实例（一）

创建vb应用程序是很简单的事。有多简单？为回答这个问题，试着创建下面的 Hello ,vb和 Firstapp

应用程序。

你好，Visual Basic

创建vb应用程序有三个主要步骤：

1. 创建应用程序界面

2. 设置属性

3. 编写代码

为了说明这一实现过程，按照以下步骤创建一个简单应用程序，该应用程序由一个文本框和一个命令按钮组成。单击命令按钮，文本框中会出现"Hello , world!" 消息。

创建应用程序界面

窗体是创建应用程序的基础。通过使用窗体可将窗口和对话框添加到应用程序中。也可把窗体作为项的容器，这些项是应用程序界面中的不可视部分。例如，应用程序中可能有一个作为图形容器的窗体，而这些图形是打算在其它窗体中显示的。

建造vb应用程序的第一步是创建窗体，这些窗体将是应用程序界面的基础。然后在创建的窗体上绘制构成界面的对象。对于目前的第一个应用程序，你可使用工具箱中的两个控件。

用工具箱绘制控件

1. 单击要绘制的控件的工具——此时是“文本框”。

2. 将指针移到窗体上。该指针变成十字线，如图 2.3 所示。

3. 将十字线放在控件的左上角所在处。

4. 拖动十字线画出适合您要的控件大小的方框（拖动的意思是按住鼠标左键用鼠标指针移动对象）。

5. 释放鼠标按钮。

控件出现在窗体上。

在窗体上添加控件的另一个简单方法是双击工具箱中的控件按钮。这样会在窗体中央创建一个尺寸为缺省值的控件；然后再将该控件移到窗体中的其它位置。

调整大小、移动和锁定控件

注意出现在控件四周的小矩形框称作尺寸句柄；下一步可用这些尺寸句柄调节控件尺寸。也可用鼠标、键盘和菜单命令移动控件、锁定和解锁控件位置以及调节控件位置。

调整控件的尺寸，请按照以下步骤执行：

1. 用鼠标单击要调整尺寸的控件。选定的控件上出现尺寸句柄。

2. 将鼠标指针定位到尺寸柄上，拖动该尺寸柄直到控件达到所希望的大小为止。

角上的尺寸柄可以调整控件水平和垂直方向的大小，而边上的尺寸柄调整控件一个方向的大小。

3. 释放鼠标按钮。

- 或 -

用 SHIFT 键加上和箭头键调整选定控件的尺寸。要移动控件，请：

1.用鼠标把窗体上的控件拖动到一新位置。

- 或 -

用“属性”窗口改变 Top 和 Left 属性。选定控件后，可用 CTRL 键加箭头键每次移动控件一个网格单元。如果该网格关闭，控件每次移动一个像素。

2.要锁定所有控件位置，请：

从“格式”菜单，选取“锁定控件”。

- 或 -在“窗体编辑器”工具栏上单击“锁定控件切换”按钮。

这个操作将把窗体上所有的控件锁定在当前位置，以防止已处于理想位置的控件因不小心而移动。本操作只锁住选定窗体上的全部控件，不影响其它窗体上的控件。这是一个切换命令，因此也可用来解锁控件位置。

创建事件过程

vb应用程序的代码被分为称为过程的小的代码块。事件过程，正如此处正要创建的一样，包含

了事件发生（例如单击按钮）时要执行的代码。控件的事件过程由控件的实际名称（Name 属性中所指定的）、下划线 (_) 和事件名组合而成。例如，在单击一个名为 Command1 的命令按钮时调用的 Name 事件过程，可称为 Command1_Click 事件过程。

要创建事件过程，请按照以下步骤执行：

1. 在“对象”列表框中，选定活动窗体中的一个对象名（活动窗体是指当前有焦点的窗体）。在这一例子中，选定命令按钮 Command1。

2. 在“过程”列表框中，选择指定对象的事件名。此时 Click 过程已经被选定，因为它是命令按钮的缺省过程。注意，这时事件过程的模板已经显示在“代码”窗口中。

3. 在 Sub 和 End Sub 语句之间输入下面的代码：

= "Hello, world!"

这个事件过程应该是：

Private Sub Command1_Click ()

= "Hello, world!"

End Sub

值得注意的是，此处代码只简单改变了控件 Text1 的 Text 属性，读入"Hello, world!"。这个例子的语法采用object. property的格式，其中 Text1 是对象，Text 是属性。响应应用程序运行中发生的事件时，可以用这种语法来改变任何窗体或控件的属性设置值。

详细信息 关于创建其它类型过程的详细信息，请参阅第五章“编程基础”中的“过程概述”一节。

运行应用程序

为了运行应用程序，可以从“运行”菜单中选择“启动”，或者单击工具栏中的“启动”按钮，或按 F5 键。单击刚才在窗体上创建的命令按钮，文本框中就会显示 "Hello, world!"。

Firstapp 示例应用程序

由于 vb提供了远比本例应用程序丰富得多的工具，因此马上可以使用许多其的特性来管理和配制应用程序。复习示例应用程序是学习vb的极好方法。下述示例展示了用 vb编制实用的应用程序是多么的轻而易举。

应用程序Firstapp 演示了如何使用 data 控件和 grid 控件显示取自数据库的信息表。vb使得从应用程序内部到数据库的访问非常地容易。数据控件提供了在数据库的记录集中漫游的功能，以及使得在 grid 控件中显示的记录与数据集中的位置同步的能力。

本例包含一个数据控件、一个MSFlexGrid 控件、一个列表框控件和两个命令按钮。网格显示了从Northwind 数据库检索到的产品的信息表。当使用数据控件上的定位按钮选定网格的一项时，被选中的产品名便显示在数据控件上。还可以双击网格中当前选择位置，在列表框控件的“购书单”中添加当前选择的书名。

用 AddItem 方法可以添加列表框的信息。方法是作用于特定对象（本例中为 ListBox 对象）的 vb函数。指定方法的语法 () 与设置属性的语法 (ty) 类似。AddItem 方法可以在程序运行时动态地添加列表框的内容。相反，Clear 方法用于清除列表框的全部信息。

详细信息 关于方法的详细内容，请参阅第三章“窗体、控件和菜单”中的“属性、方法和事件概述”一节。

创建工程

创建工程首先要从“文件”菜单中选择“新建工程”，然后从“新建工程”对话框中选定“标准

EXE”（首次启动 vb时将会显示“新建工程”对话框）。vb创建一个新的工程并显示一个新的窗体。用一个数据控件、一个MSFlexGrid 控件、一个列表框控件以及两个命令按钮画出了应用程序的界面。MSFlexGrid 控件不在缺省的工具箱内，因此必须添加：

要添加控件到工具箱，请按照以下步骤执行：

1. 选定工具箱的上下文菜单中的“部件”（可以在工具箱窗口内部单击右键显示上下文菜单。）。“部件”对话框被显示。

2. 找到“控件”列表框中的“MSFlexGrid (Microsoft Flex Grid 6.0)”项，然后选中其左边的复选框。

3. 单击“确定”按钮。在工具箱中有了MSFlexGrid 控件的图标。

使用工具箱在窗体上画出一个数据控件、一个MSFlexGrid 控件、一个列表框控件和两个命令按钮。如果您不记得如何绘制，请参阅本章前面的"Creatingthe Interface"。

设置属性根据下表在属性窗口中设置对象的属性，其余的属性均使用缺省值。

数据控件的 DatabaseName 属性必须包含数据库的实际路径。按照缺省规定， 数据库的按钮与 vb安装在同一个目录下。在属性窗口中选择 DatabaseName 属性时，可以单击该属性右侧的按钮显示标准的“打开文件”对话框浏览文件。设置完 DatabaseName 属性后，属性窗口中的 RecordSource 属性将包含选中的数据库中的表或记录集的清单。将DataGrid 控件的 DataSource

属性设置为 Data1，将自动地把网格和数据控制链接起来。

编写事件代码

程序所有的代码包含在 Command1_Click、Command2_Click、Data1_Reposition 和DataGrid1_DblClick 事件过程中。双击窗体或控件显示代码窗口，然后输入各事件过程的代码。

将以下代码添加到 Command1_Click 事件过程中，用于单击按钮时清除列表框：

Private Sub Command1_Click ()

' 清除列表框。

End Sub

以上语句调用了列表框 List1 的 Clear 方法，Clear 方法删除该列表框的内容。

将以下代码添加到 Command2_Click 事件过程中，用于从内存中卸载窗体并终止应用程序：

Private Sub Command2_Click ()

Unload Form1

End' 终止应用程序

End Sub

以上过程的第一条语句调用窗体的 Unload 事件。如果需要在终止程序时执行一个功能（例如保存文件），可以把代码放到窗体的 Unload 事件过程中。第二条语句调用 End 函数终止程序。

将以下代码添加到 Data1_Reposition 事件过程中，用于每当选择一个记录时更新标题：

Private Sub Data1_Reposition ()

n = set("Title")

End Sub

以上语句将右边的值（数据控件的记录集的 Title 字段）赋给左边的属性（数据控件对象的 Caption

属性）。

将以下代码添加到DataGrid_DblClick 事件过程中，用于当双击一个选定的行时向列表框添加信息。

Private Sub DataGrid1_DblClick ()

m set("Title")

End Sub

以上语句调用列表框 List1 的 AddItem 方法。添加到列表框中的文本被包含在该方法的参数中（此时为数据控件的记录集的 title 字段）。将一个值传递给参数类似于给属性赋值，与赋值语句不同的是不需要用等号。

保存工程

从“文件”菜单中选取“保存工程”命令来结束本次创建应用程序的工作。vb将分别提示保存窗体和保存工程。可以将工程命名为“书店销售清单” ("Bookstore Shopping List.")。Windows 95 和

Windows NT 都允许使用长达 255 个字符的文件名而且可以包含空格。旧版的 MicrosoftWindows

只允许八个字符的文件名外加三个字符的扩展名。

增强应用程序

这样第一个vb应用程序就完成了：这是一个功能简单却很有用的程序。可以以此为基础在自己的应用程序中添加新的功能，用自己的数据替换 。当然，要使本程序真正实用，还要添加基本的保存或打印列表框内容的功能、添加更多的信息,如价格、是否有货，甚至可以收集信用卡的信息和通过 Internet 传送订单。通过继续阅读《程序员指南》的其余部分将找到所有有关这些功能的例子和其它更多的知识。

用VB编写Hanoi塔问题动态演示程序

1 引言

在计算机算法设计中，使用递归技术往往使函数的定义和算法的描述简捷且易于理解。有些数据结构如二叉树等由于其本身固有的递归特性，特别适合用递归的形式来描述。还有一些问题，虽然其本身并没有明显的递归结构，但用递归技术来求解使设计出的算法简洁、易懂。因此深入掌握递归技术在算法设计过程中可以设计出更加有效的算法[1]。

简单地说，递归就是用自己定义自己。使用递归方法构造算法的基本思路是：当求解规模为n的问题时，先将其分解成若干个规模较小的与原问题具有相同特征的子问题，并找出子问题与原问题之间的组合关系，最后根据具体问题构造出递归算法。

递归算法的执行过程分“递推”和“回归”两个阶段。在递推阶段，把较复杂问题（如：规模为n）的求解推理至较原问题简单一些的问题（如规模为n-1）的求解；在回归阶段，把递推结束时所得到的解，逐级返回，依次得到稍复杂问题的解，最终得到原问题的解[2]。

Hanoi塔问题是一个典型的适合于利用递归技术得到简洁算法的例子。Hanoi塔问题源自约19世纪末在欧洲出现的一种游戏，游戏中首先在一块铜板上放置三根柱子，在第一根柱子上自上而下、由小到大顺序串着64个盘子。游戏的目标是最后将所有盘子从第一根柱子上移到第三根柱子上，移动过程中可以用第二根柱子过渡。游戏规定一次只能移动一个盘子，并且任何时刻不允许大盘放在小盘的上面。

现在就给出关于Hanoi塔问题的程序，让其将Hanoi塔问题的执行过程动态演示出来，以帮助读者加深理解递归技术。

2 算法设计

我们先利用递归技术对该问题进行算法设计。我们将三根柱子分别标号为A、B、C，目标是要将n个盘子从A柱子移动到C柱子。该问题可以设计如下的递归算法：

第一步 将A柱子上n-1个盘子借助C柱子移动到B柱子上；

第二步 将A柱子上剩余的第n个盘子移动到C柱子上；

第三步 将B柱子上的n-1个盘子借助A柱子移动到C柱子上。

对于第一步和第三步，我们又可以利用类似的方法继续将其求解过程设计为一个规模为n-1的Hanoi塔递归算法。

3 递归算法动态演示过程的程序实现

对于该算法的程序实现有两个关键的难点，其一是初始化部分如何将三根柱子和n个盘子按照问题要求在屏幕上绘制出来；其二是盘子移动过程的图形实现。

3.1 form窗体设计及程序初始化

首先在form窗体中添加三个命令按钮，如图1所示：

图1 初始界面

在开始执行Hanoi塔问题求解过程之前，需要将三根柱子绘制在屏幕上，还需要接收用户指定的盘子数及将盘子正确显示至A柱子上。在本程序中接收盘子数是利用InputBox函数接收保存至全局变量number中，用实心矩形代表盘子。

这一部分的初始化工作在准备按钮的click事件过程中实现，其核心代码如下：

Dim i As Integer

'设置Form窗体属性

n = "准备..."

'设置三个柱子的标记

CurrentX = 4000

CurrentY = hLevel + 61

ze = 16

lor = vbRed

ld = True

Print "A"

CurrentX = 8000

CurrentY = hLevel + 61

Print "B"

CurrentX = 12000

CurrentY = hLevel + 61

Print "C"

lor = &H80000012

ze = 10

ld = False

'画底线

(0, hLevel)-(15360, hLevel + 100), vbGreen, BF

'画三根柱子,A柱子的柱底坐标是(4000,10300)

'纵坐标减10只是为了显示时看的效果更好一些，其实是不应该减的，减了后柱子底端纵坐标与底线上沿纵坐标就不一致了，但屏幕视觉是一致的

(3995, 700)-(4005, hLevel - 10), vbBlack, BF

(7995, 700)-(8005, hLevel - 10), vbBlack, BF

(11995, 700)-(12008, hLevel - 10), vbBlack, BF

number = Val(InputBox("请输入盘子数：", "输入数据", "3"))

n = "共有" & number & "个盘子"

'盘子宽400*i,高度200

'相邻盘子之间的高度差设置为210，如果设置为相差200的话，当把上面一个盘子移走时两个盘子重叠部分无法重新修复

For i = 1 To number

((4000 - (i * 400) / 2), (hLevel - (number + 1 - i) * 210))-((4000 + (i * 400) / 2),

(hLevel - (number - i) * 210 - 10)), , BF

Next i

baseCoordinateY(1) = hLevel - number * 210

baseCoordinateY(2) = hLevel

baseCoordinateY(3) = hLevel

3.2 盘子移动的实现

盘子的移动过程主要有两种类型的移动，一种是垂直移动（包括自上而下和自下而上），另一种是水平移动（包括从左至右和从右至左）。盘子移动过程程序实现的主要思想是将每一次盘子从原位置移动到目标位置的路线分割成足够多的子路径，每个子路径的距离足够小，盘子从某子路径一端移动至另一端通过两个步骤来实现：第一步将原位置上的盘子颜色设置为form窗体背景色

lor，以达到将盘子从原位置移开的显示效果；第二步在盘子将要到达的新位置重新绘制该盘子，从而达到盘子移动到另一端的显示效果。

例如某个用 (4000, i)-( 4000 +400), i + 200)语句绘制的长为400像素、宽为200像素的盘子需要从矩形左上角坐标为（4000, i）的位置垂直向上移动到下一位置，则可能将该矩形在原位置重新绘制成窗体背景色，在矩形左上角坐标为（4000, i-stepC）位置重新绘制一个矩形来达到将该矩形从位置（4000, i）移动到位置（4000, i-stepC）的目的，其中stepC是移动步长，也即子路径的长度。stepC值不能设置的过大，如果设置的太大，则盘子移动过程中将会出现不连续的移动效果。盘子移动过程程序实现的核心代码如下：

Dim i As Integer, j As Integer, k As Integer 'i、k表示纵坐标，j表示横坐标

n = "汉诺塔问题-第" & n & "个盘子正在移动..."

'向上移动到first柱子顶端

For i = baseCoordinateY(pillarnum(getone)) To 600 - 210 Step -stepC

'把矩形本次移动前的图形擦掉

((pillarnum(getone) * 4000 - (n * 400) / 2), i)-((pillarnum(getone) * 4000 + (n * 400) / 2), i +

200), lor, BF

fixpillar (getone)

((pillarnum(getone) * 4000 - (n * 400) / 2), i - stepC)-((pillarnum(getone) *

4000 + (n * 400) / 2), i - stepC + 200), , BF

delay

Next i

'当前i =600-200-stepC，此时i值表示盘子的当前纵坐标

'向左、右平移到third柱子顶端

If pillarnum(getone) < pillarnum(putone) Then

'向右移

For j = (pillarnum(getone) * 4000 - (n * 400) / 2) To (pillarnum(putone) * 4000 - (n * 400) /

2) - stepC Step stepC

(j, i)-(j + n * 400, i + 200), lor, BF

(j + stepC, i)-(j + stepC + n * 400, i + 200), , BF

delay

Next j

Else

'向左移

For j = (pillarnum(getone) * 4000 - (n * 400) / 2) To (pillarnum(putone) * 4000 - (n * 400) /

2) + stepC Step -stepC

(j, i)-(j + n * 400, i + 200), lor, BF

(j - stepC, i)-(j - stepC + n * 400, i + 200), , BF

delay

Next j

End If

'向下移动到third柱子底端

For k = i To baseCoordinateY(pillarnum(putone)) - 210 - stepC Step stepC

'把矩形本次移动前的图形擦掉

((pillarnum(putone) * 4000 - (n * 400) / 2), k)-((pillarnum(putone) * 4000 + (n

* 400) / 2), k + 200), lor, BF

fixpillar (putone)

((pillarnum(putone) * 4000 - (n * 400) / 2), k + stepC)-((pillarnum(putone) *

4000 + (n * 400) / 2), k + stepC + 200), , BF

delay

Next k

'最后在柱子底端再补画一次高度为210的矩形,

'因为k循环最后一次执行循环体时，k值未必正好等于循环终值baseCoordinateY(pillarnum(putone)) - 210 - stepC,

'所以要补一个上沿纵坐标为baseCoordinateY(pillarnum(putone)) - 210 - stepC矩形

((pillarnum(putone) * 4000 - (n * 400) / 2), k)-((pillarnum(putone) * 4000 + (n * 400)

/ 2), k + 200), lor, BF

fixpillar (putone)

((pillarnum(putone) * 4000 - (n * 400) / 2), baseCoordinateY(pillarnum(putone)) -

210)-((pillarnum(putone) * 4000 + (n * 400) / 2), baseCoordinateY(pillarnum(putone)) - 210 + 200), , BF

'更新各柱子最面一个盘子上沿的纵坐标

baseCoordinateY(pillarnum(getone)) = baseCoordinateY(pillarnum(getone)) + 210

baseCoordinateY(pillarnum(putone)) = baseCoordinateY(pillarnum(putone)) - 210

End Sub

Private Function pillarnum(ch As String) As Integer

pillarnum = Asc(ch) + 1 - Asc("A")

End Function

Private Sub fixpillar(pillarABC As String)

'纵坐标减10只是为了显示时看的效果更好一些，其实是不应该减的，减了后柱子底端纵坐标与底线上沿纵坐标就不一致了

If pillarnum(pillarABC) < 3 Then

(pillarnum(pillarABC) * 4000 - 5, 700)-(pillarnum(pillarABC) * 4000 + 5, hLevel -

10), vbBlack, BF '修补柱子

Else

(pillarnum(pillarABC) * 4000 - 5, 700)-(pillarnum(pillarABC) * 4000 + 8, hLevel -

10), vbBlack, BF '修补柱子

End If

另外，需要注意的一点是当盘子垂直移动时，在盘子的原位置重新绘制盘子为窗体背景色时，由于会导致一段柱子也会被覆盖成窗体背景色，因此在原位置绘制盘子为背景色之后应立即重新绘制一次柱子。

由于目前技术水平下PC机的CPU性能比较高，程序的执行时间非常短，为了得到一个适度缓慢的盘子移动速度，在盘子移动到下一个位置时应该暂停一个时间段。本程序中通过设置一个延迟函数以达到目的，当盘子从子路径的一端移动到另一端时立即调用自定义延迟函数delay（），delay（）函数只是起到暂停程序执行的作用，不执行任何改变盘子现状的指令。一个delay（）函数的例子如下：

Private Sub delay()

Dim tt As Double

tt = Timer

While Timer - tt < 0.001 '延迟

DoEvents

Wend

End Sub

4 结束语

本文实现了一个完整的Hanoi塔问题动态演示程序，由用户输入盘子数，盘子数目限定在1至10之间，盘子太多，屏幕显示不下。程序编写、运行环境为windows xp+vb6.0，屏幕分辩率为1024×768，程序运行界面如图2所示。

图2 程序运行界面

用VB制作下雪的特技景象

对于下雪的景象大家可能都不陌生，我们还是用VB来制作一个下雪的景象吧。其实制作这样一个下雪的景象并不复杂，它的原理是首先在底色为黑色的屏幕上随机画出许多白点（雪花），然后使这些雪花不断地向下移动（重画），反复循环，就成功地模拟了下雪的景象。下面是这个小程序，你可以修改其中的一些数据调整雪花的密度和雪花落下的快慢。

双击窗体写如下代码：

Dim Snow(1000, 2), Amounty As Integer

Private Sub Form_Load()

DoEvents

Randomize

Amounty = 325

For J = 1 To Amounty

Snow(J, 0) = Int(Rnd ＊ )

Snow(J, 1) = Int(Rnd ＊ )

Snow(J, 2) = 10 ＋ (Rnd ＊ 20)

Next J

Do While Not (DoEvents = 0)

For LS = 1 To 10

For I = 1 To Amounty

OldX = Snow(I, 0): OldY = Snow(I, 1)

Snow(I, 1) = Snow(I, 1) ＋ Snow(I, 2)

If Snow(I, 1) > Then

Snow(I, 1) = 0: Snow(I, 2) = 5 ＋ (Rnd ＊ 30)

Snow(I, 0) = Int(Rnd ＊ )

OldX = 0: OldY = 0

End If

Coloury = 8 ＊ (Snow(I, 2) － 10): Coloury = 60 ＋ Coloury

PSet (OldX, OldY), QBColor(0)

PSet (Snow(I, 0), Snow(I, 1)), RGB(Coloury, Coloury, Coloury)

Next I

Next LS

Loop

End

End Sub

编写窗体的鼠标按下代码：

Private Sub Form_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Single)

unload me

End Sub

运行上面的小程序，就可以看到漫天的雪花在缓缓落下，地面上还会有积雪！鼠标单击可结束程序。