Visual Basic COM基础讲座之

简介



首先，COM是一种通信的方式。

例如，就像我们的电视遥控一样。当我们按下某个频道按钮时，电视频道立马切换；而当我们按下开关按钮时，电视立即关闭等等。其实，我们并不关心它们是怎样工作的，我们只知道按下按钮就能产生某个动作就可以了。

程序的原理也是一样的。当改变文本编程控件的Text属性时，我们并不知道其中的原理，也许系统内部会调用几十个API函数也说不定？但对于用户来说，则只关心文本编程控件中显示的文本就可以了。

其次，COM是一种重用代码的方式。

使用COM的最大好处是一旦建立COM的通信方式后，可以方便地在任何地方使用多次。例如，当用户创建一个用于显示日期和时间的COM组件后，就可用于任何程序中的任何地方。不仅VB应用程序、Excel程序可以访问，而且C++应用程序也可以访问它。

所以，COM组件的代码可重用性是最主要的。

再次，COM是基于实际对象的。

用COM创建的大多数组件是基于实际对象的，这就意味着一旦组件被创建，其使用是相当容易的。试想一下，如果我们在计算机系统中再添加一个用户，又有哪种添加方式如Customer.Add那样简单，是添加数据处理代码包、算法，还是向应用程序添加较大的数据库DLL？很显然，COM就支持这种简单操作。

所以，COM是一种通信方式、一种代码重用方式以及基于实际对象的。

本教程的以后部分中将简单讨论COM和VB的相关内容，这包括类的创建，以及如何将类转换成一个实际对象。虽然，这里的内容太过简单，但却是以后COM编程的基础。



属性



属性操作很像公共变量，但属性还有更多的控制。

常用属性通常包括"Get(获取)"和"Let(设置)"两种。这两项操作能规定一个主要属性，就像下面的代码片段：

　　Private intAge As Integer

　　　Public Property Get Age() As Integer

　　　Age = intAge

　　End Property

　　Public Property Let Age(ByVal vNewValue As Integer)

　　　intAge = vNewValue

　　End Property

上述代码的工作方式极像Age变量的操作。当像下面语句操作变量时，

MyDog.Age = 4

就好比运行Let属性，并将4赋给vNewValue。当像下面语句操作变量时，

MsgBox MyDog.Age

是获取属性，就好比运行Get属性，并将相应的值由intAge返回。因此，我们可以这样认为：

所谓Get属性，就是运行后获取某个值；

所谓Let属性，就是运行后让某个属性等于某个值；

但至此为止，我们仅仅说明属性工作方式与标准变量极为相似，还没有来得及对属性进行更多的控制。所以，下面就来讨论。

打开上一节的工程，对CDog类进行如下修改：

从CDog类中去掉Age变量；

添加下列代码：

　　FACE="Courier" SIZE=2>

　　Private intAge As Integer

　　Public Property Get Age() As Integer

　　　Age = intAge

　　End Property

　　Public Property Let Age(ByVal vNewValue As Integer)

　　　If vNewValue <= 50 Then

　　　　intAge = vNewValue

　　　End If

　　End Property

与前面的代码相比，这里只是对Let属性代码作稍加修改。下面对其作小小的测试，假想用户试图想使：

MyDog.Age=30

也就是运行Let属性，使vNewValue等于30。代码中，还检测vNewValue是否小于或等于50。显然，30是符合要求的，因此实例中的intAge值等于30。但如果超过50，则什么也不会发生，属性退出且没有任何赋值。当然，我们也可以对此给出相应的错误代码或是显示一个提示对话框。

切换到Form1后面的代码窗口；

在设置Age属性代码处的第一行语句中单击鼠标，并按F9；

MyDog.Age = 4

在获取Age属性代码处的第一行语句中单击鼠标，并按F9；

MsgBox MyDog.Name & " is " & MyDog.Age & " years old"

现在让我们测试一下：

按F5运行程序；

单击Command按钮；

代码应该中断在按F9添加的断点的代码行上。

当代码中断后，按F8单步运行并观察结果；

现在明白它们是怎样工作的吗？注意Age属性的"get"和"let"是怎样运行的？

在下一节中，我们不仅要讨论使用更多属性的方式，而且还讨论如何随意创建它们。



更多属性



有时候，为了更好地处理类往往需更多的属性。例如，假如你有四种不同的客户群：集团、较大、较小和新的客户类型，或者一个用于搜索的类中有三种不同的搜索方式：软盘、硬盘和网络。那么，能不能最好从选项列表中选择一个，而不是用不能理解的数字或文本来设置相关属性？

我想，答案是肯定的。因为这种处理就称为"枚举"。

打开上一节的工程，让我们添加一些代码。

在CDog类中添加下列代码：

　　Public Enum CoatType

　　　BigAndShaggy = 1

　　　ShortCrewCut = 2

　　　PoodleStyleAfro = 3

　　　Unknown = 4

　　end Enum

关键词"Enum"就是用来定义枚举的，换句话说，它是可能选项的列表。各选项都有相应的数字，也就是说BigAndShaggy表示1，ShortCrewCut等于2，等等。

需要注意的是，当将枚举项相关信息添加在数据库中时，其相应的数值是非常有用的。由于"BigAndShaggy"实际代表的是数值1，所以可以直接将其插入到数据库的数值字段中。这就意味着，可以方便使用字符串来维护数据库。

所以，我们来创建一个Dog的Coat类型列表，并另外定义一个属性，将这些类型添加在CDog类中。

在类中声明下列变量：

　　Private udtCoat As CoatType
这个定义的私有变量用来保存即将添加的Coat类型属性，注意到udtCoat变量既不是字符串也不是整型，而是我们自己定义的枚举类型CoatType。

当类CDog打开时，选择"Tools"菜单中的"Add Procedure"命令，弹出相应的对话框；

Name编辑框中键入Coat；

选中"Property"选项按钮，然后单击[OK]。

系统自动产生下列代码框架：

　　Public Property Get Coat() As Variant

　　End Property

　　Public Property Let Coat(ByVal vNewValue As Variant)

　　End Property

但我们需要的却不是这个框架。代码中，"Variant"变量类型是能接收和处理任何类型数据。在我们定义的CDog类中，最后的属性是Age，它只能接受整型。但现在需要属性能接收CoatType列表中的数据类型，因此需要作下列修改：

将产生的代码中所有的"Variant"改成"CoatType"；

然后，添加一些实际处理属性的代码。

在属性的Get过程中，添加下列代码：

Coat = udtCoat

在属性的Let过程中，添加下列代码：

udtCoat = vNewValue

切换到Form1；

将Command按钮的代码改为：

Dim MyDog As CDog

Set MyDog = New CDog

MyDog.Name = "Billy"

现在开始键入：MyDog.Coat =

奇迹出现了，当你敲下"="键时，出现一个含有可能选项的列表，从中我们可以选择一个。

完成代码的键入：MyDog.Coat = ShortCrewCut

下一步，我们将获取Coat属性的值。假如现在就来简单地在消息对话框中显示属性值，则只需返回选择项的值就可以了。例如，若选择了ShortCrewCut，其属性一定返回2。不信，可以试一试！

但这里采用另外一种方法，它是用If-Then语句判断Coat：

在Command按钮已有的代码后面添加下列代码：

　　If MyDog.Coat = BigAndShaggy Then

　　　MsgBox "You have a big, bouncy, bushy pup!"

　　ElseIf MyDog.Coat = PoodleStyleAfro Then

　　　MsgBox "Your pooch is pretty, petit and pooch-like!"

　　ElseIf MyDog.Coat = ShortCrewCut Then

　　　MsgBox "Your dog is full of oomph, oomph and more oomph!"

　　ElseIf MyDog.Coat = Unknown Then

　　　MsgBox "I have no idea about your dog. I don't think " & _

　　　　　　　 "you do either!"

　　End If

这里的代码只是简单判断Coat属性值，并显示相应的消息对话框。当然，这里也可以使用"Select Case"语句。

最后，我们添加最后一条语句来释放计算机内存：

在Command按钮已有的代码后面添加下列代码：

Set MyDog = Nothing

按F5运行程序，并单击Command按钮测试一下。

结果怎样？



事件



相对来说，事件的使用是比较简单的。在使用前，我们必须先定义该事件，这就意味着通知Visual Basic什么事件被调用。一个事件可能有自己的参数，例如，一个Command按钮有一个Click(单击)事件，它没有参数。另外，文本编辑框有一个KeyPress事件，它通过一个叫"KeyAscii"的值来处理相关内容。

定义一个事件是在一个类的通用声明部分添加类似下面的代码：

Public Event MyEventName(PossArguments As String, Etc As Variant)

然后在代码调用RaiseEvent方法来激发一个事件。就像下面的代码一样：

RaiseEvent MyEventName("PossArgs", "Etc")

为了更好地说明上述添加和激发事件的过程，我们举一个例子。首先，定义一个事件：

在CDog类的通用声明部分添加下列代码：

Public Event Awake()

在CDog类中添加Sleep子过程：

Public Sub Sleep()

　Dim i As Long

　For i = 1 To 1000000

　　DoEvents: DoEvents: DoEvents

　　exit

　　RaiseEvent Awake

End Sub

代码中，一开始做一些1000000次无用的循环，计算机短暂停顿后，Sleep子过程激发Awake事件。

但Awake事件产生后，我们应该让程序作相应的反应呢？当然，利用命令按钮是最简单的，只要在代码窗口的列表中选择命令按钮对象。

但是那样的话，我们必然需要一个控件，而且所见的内容都在表单上。这里我们纯粹使用相应的代码，并且是不可见的。

当然用代码来接收事件，还需要额外的操作：

在表单代码窗口中的通用声明部分，添加下列代码：

Dim WithEvents MyDog As CDog

该代码不同于以前的MyDog声明，它有个关键词WithEvents用来通知Visual Basic该对象可以按收任何事件，而且该对象必须接收事件。

删除命令按钮中的所有代码；并在Command1中添加下列代码：

Set MyDog = New CDog

MyDog.Name = "Billy"

MyDog.Bark

MyDog.Sleep

该代码简单地将MyDog设置成CDog的一个新的实例，设置Name后，调用Bark，最后运行Sleep子过程。

现在添加一些代码来相应Awake事件。

在Form代码窗口中，从对象下拉列表中选择"MyDog"；

在"MyDog"的"Awake"事件中，添加下列代码：

　　Private Sub MyDog_Awake()

　　　MsgBox "Your pooch has awoken!"

　　End Sub

好了，现在就可以测试了。

按F5运行程序；

单击Command按钮；

这样，当小狗Bark后，开始打盹，最后结束时还被你叫醒。真是神奇！



类的建立



在本节中，我们来实践一下。首先创建一个COM对象，然后使用它，最后再想法改进。

首先进行下面两步：

运行Visual Basic；选择 "Standard EXE"工程类型；由于COM对象是基于类的，而类实际上是程序包，就像模块中的代码一样。所以：

选择"Project"->"Add Class Module"；当相应的对话框出现后，选择"'Class Module"，然后单击"Open"按钮。

这样，在桌面上显示一个表单，以及包含在工程Project1中的Class1。

下面再将空的类的类名更改：

在类的属性窗口中，将类的Name属性改成CDog。

需要说明的是，为了区别起见，每个对象名的前面都有相应的前缀，例如Text Box对象前是"txt"、Form前是"frm"、类前可以大写字母"C"或小写字母"cls"，但这里使用前者。

下面我们添加一些代码来测试一下：

在CDog类通用声明部分中，添加变量的声明：

Public Name As String

然后，打开Form1；

在表单中添加一个命令按钮；

打开代码窗口，为该命令按钮添加下列代码：

　　Dim MyDog As CDog

　　Set MyDog = New CDog

　　MyDog.Name = "Billy Moore"

　　MsgBox MyDog.Name

　　Set MyDog = Nothing

下面就来解释上述代码的含义：

Dim MyDog As CDog

该行语句是用来通知Visual Basic为CDog对象设置一个位空间，但这时还不能使用该对象，必须等到下条语句为止：

　　Set MyDog = New CDog

它是用来创建CDog的实例。这就意味着前面空的MyDog模板变成了现在可以使用的CDog对象。

　　MyDog.Name = "Billy Moore"

　　MsgBox MyDog.Name

上述代码的第一行是用来设置MyDog的Name变量，同时第二行语句是用来将该变量的内容显示在消息对话框中。最后：

　　Set MyDog = Nothing

用来将MyDog对象简单的置空。

按F5键运行并测试。

怎么样？但同时，我们可能不禁要问，标准模块和类模块究竟有什么不同？我们再来看看下面的示例：

将命令按钮的代码变成：

　　Dim MyDog As CDog

　　Set MyDog = New CDog

　　Dim MyDog2 As CDog

　　Set MyDog2 = New CDog

　　MyDog.Name = "Billy Moore"

　　MsgBox MyDog.Name

　　MyDog2.Name = "Sadie Moore"

　　MsgBox MyDog2.Name

　　Set MyDog = Nothing

　　Set MyDog2 = Nothing

与最前面的代码不同的是，这里的代码实际上是定义两个对象MyDog和MyDog2，这两个对象是基于CDog的相互独立的两个对象。

按F5键运行并测试。

结果怎样？这一次是不是有两个对话框出现？一个显示"Billy Moore"，另一个显示"Sadie Moore"。

上述定义的每个对象中除了Name外，没有任何实际的属性，因此下面过程就来添加：

打开前面的Class1；

声明下面的公共变量：

　　Public Age As Integer

打开前面的Form1；

将命令按钮的代码变成：

　　Dim MyDog As CDog

　　Set MyDog = New CDog

　　Dim MyDog2 As CDog

　　Set MyDog2 = New CDog

　　MyDog.Name = "Billy Moore"

　　MyDog.Age = 4

　　MsgBox MyDog.Name & " is " & MyDog.Age & " years old"

　　MyDog2.Name = "Sadie Moore"

　　MyDog2.Age = 7

　　MsgBox MyDog2.Name & " is " & MyDog2.Age & " years old"

　　Set MyDog = Nothing

　　Set MyDog2 = Nothing

这些代码和前面差不多，只不过这里使用了Age变量。

按F5键运行并测试。

应该出现显示name和age内容的两个消息对话框。

现在再试着将其中一个对象的age值设置成1,000或者30,000。看看结果如何？程序照样正常运行，这是因为定义的整型变量最大值可达32,767，但是实际中的狗(Dog)是不会有30,000岁的。

那么，这种情况应该怎样处理呢？



兼容性



在本教程第二部分的最后，我们遇到一个小问题，但确切地说，那实际上是一个大问题。如果有时间的话，这个问题应该值得我们花大精力去研究。

还记得我们是怎样遇到那个问题吗？当时，我们先编译ActiveX DLL，然后编译使用该DLL的测试程序。接着，我们重新编译DLL，那是因为假设DLL中的内容需要修改。然而，再运行测试程序时，却出现错误！

虽然，我们可以重新编译测试程序，以便该程序能正确运行。但是，如果这里不是VB程序，而是Excel数据表或是C++统计程序在使用该DLL，那么是不是每次对ActiveX DLL进行小小的修改后都要重新编译这些程序呢？

是的，肯定不能这样。

因为经验告诉我们，这是一个兼容性问题。所以，可以这样处理：

启动Visual Basic，打开Northwind工程；

选择"Project"->"Northwind Properties"菜单；

单击"Component"标签；

浏览一下"Version Compatibility"的页面内容，可以发现有三个选项。现解释一下：

No Compatibility
—— 每次编译时，用户COM组件都被标有一个新的标记，这就意味着程序只能使用旧标记(以前版本)的DLL。

Project Compatibility—— 每次编译时，用户COM组件不是总会被标有一个新的标记。如果是的话，任何当前使用的应用程序都会失败。事实上，只有当当前工程和已经编译过的DLL工程有较大不同时才会这样。

Binary Compatibility
—— 每次编译时，应用程序总试图保存前一个编译过的DLL标记，这样就确保了使用的应用程序不会出现蓝屏的死机现象。但是，若当前将要编译的DLL和以前编译过的DLL区别太大，则新的标记就会被标上。

让我们测试一下上述论点：

打开本教程上一部分的测试程序；

重新编译一下；

试运行一下，应该能正常工作；

打开ActiveX DLL工程；

将其属性设置为Binary Compatibility；

重新编译一下该DLL；

试运行一下测试程序，应该能正常工作。

好了，看起来似乎解决了问题。但当重新编译DLL后，大多数开发人员将会陷入另一种不兼容的境地。

难道就没有更好的解决办法吗？我们暂时将这个问题放到一边！

您可访问下列站点以获得更多的内容：

　　www.PylonOfTheMonth.co.uk.

在VB程序中处理随机事件

　　在Visual Basic(以下简称VB)程序设计过程中，如何轻松地处理众多的随机事件，往往是***大型系统首先要考虑的问题之一。例如，多个窗口同时打开同一个表（Table），一个窗口中对数据进行了修改，而其它窗口也能够随之进行数据更新，这时就需要有一条说明数据改变了的消息在所有窗口间进行广播。在C中，只需要定义一条用户消息即可实现这一点；而用VB编程就不那么简单。

早期实现方法及局限性

　　对于以上问题，笔者早期的实现方法是，自定义一个消息结构（VbMsg），并在程序的主窗体内建立一个消息广播引擎，主要由一个消息队列和一个定时消息广播器所组成。消息广播器每隔一固定时间检查一次消息队列，如果有消息存在，就将其发送给所有打开的窗口，并将该消息从队列中删除。如此再定义一个全局的消息发送过程（SendMsg），将要发送的消息（VbMsg）送入消息队列。这样当需要广播消息时，只需填充好消息结构，调用SendMsg过程即可。　

　　这里较为复杂的是消息广播器如何将消息发送到各窗口。这需要作个硬性规定，即每一个窗体都必须定义一个形式完全相同的消息接收函数（RecMsg），在这个函数中对接收到的消息进行处理，当然也可以什么都不做。有了这样的规定之后，消息广播器在进行广播时，就可以利用VB系统定义的全局变量Forms，遍历所有的窗体，并调用一遍每个窗体的消息接收函数。其主要代码如下：

Public Sub SendMsgToForms(msg as VbMsg) 
Dim frm as Form 
For Each frm In Forms 
frm.RecMsg msg 
Next frm 
End Sub 　

　　通过上面的这些过程，就可以实现在独立的程序中，对随机事件进行异步处理。这一方法的效果基本令人满意。但是它有几个较大的局限性：

　　？　定时检查消息队列需要利用Timer控件进行触发，这在程序运行时，就必然要牺牲一部分效率；

　　？　消息广播的范围限定在一个程序模块内，如果整个系统分成多个大的模块，那么存在于动态链接模块（.DLL）中的窗体将不能直接接收到广播消息，更无法实现进程间的消息传递；

　　？　消息的接收者只能是窗体，而作为真正的基础单元“类”却无法直接接收消息。　

VB5.0的新特性及实现方法

　　VB 5.0 企业版增添了 嗲坑辛Φ奶匦裕可以解决以上难题。?/p>

　　1、 用户自定义事件

　　在类模块中，可以使用Event关键字来定义用户自定义事件，使用 RaiseEvent 语句来产生该事件，这一机制给处理随机事件带来了很大方便。本文中的消息广播引擎，就可以不再使用Timer控件做支持，而是当收到需要广播的消息时，产生一个预定义的事件；而需要处理消息的客体对象，只需截获该事件。

　　2、 ActiveX EXE组件

　　利用VB，可以方便地将共享代码封装在ActiveX组件之中，从而可以实现跨进程间的消息传递。因为ActiveX组件有内部（DLL）、外部（EXE）两种，外部组件可以对模块内的全局数据实现共享。

　　3、 远程自动化连接

　　ActiveX组件是一种标准的客户机/服务器结构，利用Windows平台的COM模型，VB能够方便地将这种结构扩展到整个网络的范围。所以，消息广播设计既可实现进程间的消息传递，也可实现网络上的消息传递。

　　根据以上思想，笔者通过四个模块之间的相互协作，完成了消息的发送、广播及接收，并将这四个模块封装在一个ActiveX EXE组件之中。下面就是这四个类模块的简单介绍及源代码。

　　类模块之一：Msg.cls

　　该模块定义了消息数据结构VbMsg类，它是消息传递中的载体。这里只是一个简单的例子，如果想实现更多的功能，如建立两点间的数据通道，而不是单纯的广播消息，则要对该结构进行一些扩充。

　　BEGIN

　　MultiUse = －1 True

　　END

　　Attribute VB_Name = “VbMsg"

　　Attribute VB_GlobalNameSpace = False

　　Attribute VB_Creatable = True

　　Attribute VB_PredeclaredId = False

　　Attribute VB_Exposed = True

　　Option Explicit

　　消息类：定义全局的消息结构

　　Public iType As Long 消息类型编号

　　Public iName As String 消息名

　　Public iSource As String 消息源说明

　　Public iDescription As String 消息说明

　　Dim iT As Date 消息发生时间

　　返回日期型时间

　　Public Property Get iTime() As Date

　　iTime = iT

　　End Property

　　返回字符型时间

　　Public Property Get iTimeStr() As String

　　iTimeStr = Format(iT, “yyyy.mm.dd hh:mm:ss")

　　End Property

　　在对象被建立时，设置消息发生时间

　　Private Sub Class_Initialize()

　　iT = Now()

　　End Sub

　　类模块之二：MsgCli.cls

　　本模块是对客户接收端MsgClient类的定义，这相当于一个消息***。在这个类中定义的一个RecMsg事件，当***收到消息时（过程SetMsg被调用），就产生这一事件；***的建立者截获这一事件，并处理消息。为了避免接收不必要的消息，声明了minMsg、maxMsg两个变量，以便对VbMsg中的iType属性进行过滤。

　　BEGIN

　　MultiUse = －1 True

　　END

　　Attribute VB_Name = “MsgClient

　　Attribute VB_GlobalNameSpace = False

　　Attribute VB_Creatable = True

　　Attribute VB_PredeclaredId = False

　　Attribute VB_Exposed = True

　　Option Explicit

　　客户消息接收类

　　定义接收消息事件，该对象的宿主类应截获该事件，并处

　　理接收到的消息

　　Public Event RecMsg(ByVal msg As VbMsg)

　　通过设置消息的接收范围，过滤掉不需要的消息

　　Public minMsg As Long

　　Public maxMsg As Long

　　该对象的标志编号，使用时不应修改该值

　　Public ID As Long

　　事件产生过程，只应由消息服务器（MsgServer）调用

　　Public Sub SetMsg(msg As VbMsg)

　　If msg.iType ＞= minMsg And msg.iType ＜= maxMsg Then

　　RaiseEvent RecMsg(msg)

　　nd If

　　nd Sub

　　根据ID返回对象的关键字，只应由消息服务器调用

　　Public Property Get Key() As String

　　Key = “ID:＆ ID

　　End Property

　　类模块之三：Global.bas

　　本模块声明了两个全局变量，一个是***（MsgClient）列表（Clients），一个是***计数器，为每个***分配一个唯一的ID标志。把变量放在单独的模块中，是为了实现数据在进程间的共享，是跨进程间消息传递的关键所在（应保证在编译时工程是单线程的，否则不能实现数据共享）。

　　Attribute VB_Name = “modGlobal

　　Option Explicit

　　消息服务器全局变量，消息接收客户列表

　　Public Clients As New Collection

　　消息接收客户ID计数器

　　Public CliCount As Long

　　类模块之四：MsgSrv.cls

　　本模块定义了消息服务器类MsgServer，该类是消息广播引擎的主体，它主要管理维护消息***列表（Clients），将发送来的消息（调用SendMsg过程）依次发送给列表中的所有***。请注意：为了方便使用，该类被声明为公共全局类。

BEGIN 
MultiUse = －1 True 
END 
Attribute VB_Name = “MsgServer 
Attribute VB_GlobalNameSpace = True 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = True 
Option Explicit

　　消息服务器类，发送消息

Public Sub SendMsg(msg As VbMsg) 
Dim c As MsgClient 
For Each c In Clients 
c.SetMsg msg 
DoEvents 
Next c 
End Sub

　　增删消息接收客户

Public Sub AddMsgClient(c As MsgClient) 
CliCount = CliCount ＋ 1 
c.Id = CliCount 
Clients.Add c, c.Key 
End Sub 
Public Sub DelMsgClient(c As MsgClient) 
Clients.Remove c.Key 
If Clients.Count = 0 Then CliCount = 0 
End Sub

　　应用举例

　　至此，一个小巧灵活的消息广播引擎就完成了，它的使用范围很广，用起来也很方便，只需在工程中引入编译过的ActiveX组件，就可以直接调用SendMsg发送消息。但可能在安装消息***（MsgClient）时会稍许有点麻烦，下面举例说明其应用。

　　在设计Windows程序时，往往希望调试时能看到程序运行时后台的一些情况。利用VB的单步执行或Debug命令，会受到一些限制。利用消息广播引擎，***一个通用的实时消息事件查看程序，就可以很好地解决这一问题。查看程序的主要工作是捕捉一组事先定义好的消息事件，并将消息的内容显示在列表框内。本应用可以只用一个窗体完成，主要代码如下。

Const MsgInfoID=101 
Private WithEvents mClient As MsgClient 
Private Sub Form_Load() 
Set mClient = New MsgClient 
MClient.minMsg= MsgInfoID 
MClient.maxMsg= MsgInfoID 
AddMsgClient mClient 
End Sub 
Private Sub Form_Unload(Cancel As Integer) 
DelMsgClient mClient 
End Sub 
Private Sub mClient _RecMsg(ByVal msg As VbMsgSrv.VbMsg) 
List1.AddItem msg.iTimeStr ＆ Chr(9) ＆ msg.iName ＆ Chr(9) ＆ 
sg.iDescription 
End Sub

　　在被调试的程序中，为了调用方便，可以编写一个全局过程：

Const MsgInfoID=101 
Public Sub MsgInfo(iName As String,iDes As String) 
Dim msg As New MsgClient 
With msg 
.iName = iName 
. iDescription = iDes 
End With 
SendMsg msg 
End Sub

　　在程序的重点环节插入MsgInfo过程，运行时有关信息就会在事件查看程序的窗口中显示出来。这种方法尤其适合调试多程序协作的软件系统。当软件系统正式交给用户时，插入的MsgInfo过程也不一定要全部删掉，只要将实时查看改为写入日志文件，作为日后软件维护的资料。

消息传递在VB中的应用

　　有些窗体在设计时会定义一些特殊的功能消息，而当我们传递这些消息给这类窗体时，这类窗口就会执行某段程序，并返回执行的结果。为了让程序可以送出消息，Windows提供了SendMessage
API函数。

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

　　hWnd:接收消息的窗口；

　　wMsg:消息的编号；

　　wParam:消息的第一个参数；

　　lParam:消息的第二个参数。

　　wParam及lParam参数的意义会随着wMsg参数而变，因此我们要传递消息给某一个窗体时，除了了解该消息的意义外，还要了解wParam及lparam的意义。

　　lParam参数在SendMessage定义句中为"lParam As Any",因此它有以下几中写法：

　　当数值为 0 时，写成:ByVal 0&

　　当为字符串常数 时，写成:ByVal "字符串的内容"

　　当为字符串变量时，写成:ByVal S

　　第一个实例：对窗体进行操作



　　下面我们对窗体的几个消息进行解释和应用：

WM_GETTEXT:读取窗体的Caption属性；

WMSETTEXT:设置窗体的Caption属性；

WM_SYSCOMMAND(wParam=SC_MAXIMIZE)：将窗体的属性设置为2；

WM_SYSCOMMAND(wParam=SC_MINIMIZE):将窗体的属性设置为1;

WM_SYSCOMMAND(wParam=SC_RESTORE):将窗体的属性设置为0；

WM_SYSCOMMAND(wParam=SC_CLOSE)：Unload窗体.

　　下面我们在窗体上放置几个Command控件和一个Text控件：






　　我们先把所需要的参数和API函数定义到模块里面：

Public Const WM_SYSCOMMAND = &H112
Public Const SC_CLOSE = &HF060& '关闭窗体
Public Const SC_MINIMIZE = &HF020& '最小化窗体
Public Const SC_MAXIMIZE = &HF030& '最大化窗体
Public Const SC_RESTORE = &HF120& '恢复窗体大小
Public Const WM_SETTEXT = &HC '设置窗体的Caption
Public Const WM_GETTEXT = &HD '取得窗体的caption
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

双击Command中放入：

Private Sub Command_Click(Index As Integer)
　Dim S As String
　S = String(80, Chr(0))

　Select Case Index
　　Case 0
　　　SendMessage Me.hwnd, WM_GETTEXT, Len(S), ByVal S '读出窗体的Caption
　　　Text1.Text = Left(S, InStr(S, Chr(0)) - 1)
　　Case 1
　　　'因为Text1.text属于Variant类型，所以一定先要用CStr把它转换成字符串
　　　SendMessage Me.hwnd, WM_SETTEXT, 0, ByVal CStr(Text1.Text)'设置窗体的Caption
　　Case 2
　　　SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, ByVal 0&'使窗体最大化
　　Case 3
　　　SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MINIMIZE, ByVal 0&'使窗体最小化
　　Case 4
　　　SendMessage Me.hwnd, WM_SYSCOMMAND, SC_RESTORE, ByVal 0&'使窗体恢复原来的大小
　　Case 5
　　　SendMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&'关闭窗体
　　End Select

End Sub

　　第二个实例：TextBox的消息

消息	用途
EM_LINESCROLL	以行为单位，卷动TexBox
EM_SCROLL	以行或页为单位，卷动TexBox
EM_GETLINECOUNT	读取TextBox的总行数
EM_GETLINE	读取某一行的字符串
EM_LINEINDEX	读取某一行的第一个字符在TextBox中的索引
EM_LINELENGTH	读取某一字符索引所在行次的"行字符数"
EM_CHARFROMPOS	读取鼠标所在位置的字符索引
EM_SETSEL	设置选取区域

　　在窗体上放置好相应的控件，如下：




　　在模块中定义好所需要的变量和函数：

Public Const EM_SCROLL = &HB5 '以行或页为单位，卷动TexBox
Public Const SB_LINEUP = 0 '上卷一行
Public Const SB_LINEDOWN = 1 '下卷一行
Public Const SB_PAGEUP = 2 '上卷一页
Public Const SB_PAGEDOWN = 3 '下卷一页
Public Const EM_LINESCROLL = &HB6 '以行为单位，卷动TexBox
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

　　双击Command，写入以下代码：

Private Sub Command_Click(Index As Integer)
　Select Case Index
　　Case 0
　　　SendMessage Text1.hwnd, EM_SCROLL, SB_PAGEUP, ByVal 0&'上卷一页
　　Case 1
　　　SendMessage Text1.hwnd, EM_SCROLL, SB_LINEUP, ByVal 0&'上卷一行
　　Case 2
　　　SendMessage Text1.hwnd, EM_SCROLL, SB_LINEDOWN, ByVal 0&'下卷一行
　　Case 3
　　　SendMessage Text1.hwnd, EM_SCROLL, SB_PAGEDOWN, ByVal 0&'下卷一页
　　Case 4
　　　'Text1.text用来输入水平方向行数的TextBox,Text2.text:用来输入垂直方向行数的TextBox
　　　'因为lParam采用"As Any"的定义方式，所以我们传入是一定要将参数强制设置成Long类型
　　　SendMessage Text1.hwnd, EM_LINESCROLL, Val(Text1.text), ByVal CLng(Val(Text2.text))
　End Select
End Sub

　　第三个实例：ListBox的消息

消息	用途
LB_SELECTSTRING	选取开头含有某个字符串的选项
LB_FINDSTRING	搜寻开头含有某个字符串的选项
LB_FINDSTRINGEXACT	搜寻完全相符的选项
SETHORIZONTALEXTENT	设置水平滚动条的宽度
LB_ITEMFROMPOINT	检测鼠标所在位置的选项

　　下面我们用一个例子来说明这些消息的具体用法：

　　在窗体上放置好一个Lable,Text,List,三个Command控件.并在List控件中输入字母，且最少有一行要超出List的水平宽度。




　 　 在模块中定义相应的参数和函数:

Option Explicit
Public Const LB_FINDSTRING = &H18F '搜寻开头含有某个字符串的选项
Public Const LB_FINDSTRINGEXACT = &H1A2 ‘搜寻完全相同的字符串的选项
Public Const LB_ITEMFROMPOINT = &H1A9 '检测鼠标所在的位置的选项

Public Const WM_USER = &H400
Public Const LB_GETITEMHEIGHT = (WM_USER + 34)'取得List的行间高度
Public Const LB_SETITEMHEIGHT = &H1A0 '设置得List的行间高度
Public Const WM_SETREDRAW = &HB

Public Const LB_SETHORIZONTALEXTENT = &H194 '设置水平滚动条
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
在Text1_Change中加入如下代码:
Private Sub Text1_Change()
　Dim Search As String, Index As Long

　Search = Text1.Text
　If Len(Search) > 0 Then
　　Index = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal Search)
　　 '搜寻开头含有某个字符串的选项
　　List1.ListIndex = Index
　Else
　　List1.ListIndex = 0
　End If
End Sub
'下面的代码为设置水平滚动条的宽度
Private Sub Command2_Click()
　Dim max As Long, f As Font, i As Integer

　Me.ScaleMode = vbPixels ' 以像素为单位
　Set f = Me.Font ' 保留窗体的Font
　Set Me.Font = List1.Font 
　 ' 将List1的Font设置给窗体，便可用窗体的TextWidth方法来计算ListBox每一个选项的宽度
　With List1
　　For i = 0 To .ListCount
　　　If Me.TextWidth(.List(i)) > max Then
　　　　max = Me.TextWidth(.List(i))
　　　End If
　　Next
　End With
　max = max + 10 ' 
　Set Me.Font = f ' 还原窗体的Font
　SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, max, ByVal 0&
End Sub
'当我们的鼠标在List中移动时可以检测鼠标所在的位置，其代码如下：
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
　Dim lXPoint As Long
　Dim lYPoint As Long
　Dim lIndex As Long
　If Button = 0 Then ' 如果没有按钮被按下
　　lXPoint = CLng(X / Screen.TwipsPerPixelX)'List的宽度(以Pixel为单位)
　　lYPoint = CLng(Y / Screen.TwipsPerPixelY)'List的高度(以pixel为单位)
　　With List1
　　　' 获得当前的光标所在的的屏幕位置确定标题位置
　　　lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
　　　' 显示提示行或清除提示行
　　　If (lIndex >= 0) And (lIndex <= .ListCount) Then
　　　　　.ToolTipText = .List(lIndex)
　　　Else
　　　　　.ToolTipText = ""
　　　End If
　　End With
　End If
'我们也可以设置List的行间高度，代码如下：
Private Sub Command1_Click()
　Dim i As Long
　'返回 listbox高度
　i = SendMessage((List1.hwnd), LB_GETITEMHEIGHT, 0, &O0)
　'在原高度中增加一个值
　i = i + 3
　'设置高度
　i = SendMessage((List1.hwnd), LB_SETITEMHEIGHT, 0, ByVal i)
　i = SendMessage((List1.hwnd), WM_SETREDRAW, True, 0&)
End Sub