事件处理示例代码（一）

以下内容接《事件处理》，略做编辑。原文链接

http://blog.sina.com.cn/s/blog_4e7c08c20100awpl.html

一、SendMessage函数应用（LB_打头的消息，列表框控件）

在Windows系统的很多消息中，有一些不仅仅是提供一个窗口消息那么简单。它们可以控制窗口的动作和属性。下面向大家介绍SendMessage函数在扩充列表（ListBox）控件功能方面的应用

在 Windows 中，有一系列的以 LB_ 开头的列表消息，这里介绍的就是利用LB消息控制的ListBox的应用

1 用LB_ITEMFROMPOINT获得提示 (ToolTip)

在列表框控件中有一个 ToolTipText属性，该属性决定了当光标在列表框上移动时出现的提示文字。但是如何让当光标在不同的列表项上移动时的提示文字也不同呢？问题的关键是要知道在光标移动时光标所在的列表项的索引，使用SendMessage函数发送 LB_ITEMFROMPOINT消息就可以获得。

在 Form1 中加入一个 ListBox 控件，运行程序，当光标在列表中移动时，可以看到根据光标所在的不同的列表项，提示文字也不相同。代码如下（我已试验成功）：

Const LB_ITEMFROMPOINT = &H1A9
Private Sub Form_Load()
	Dim ZXS As Long
	Drive1.Drive = "G:": Dir1.Path = "G:\一江秋水的文档"
	Combo1.Text = Combo1.List(0)
	ZXS = SendMessage(Text1.hwnd, 186, 0, 0)
	Label1.Caption = "共 " & ZXS & " 行，" & Len(Text1.Text) & " 字"
	For i = 1 To 200: List1.AddItem str(i) + " 列表框试验项目": Next
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
	Dim lXPoint As Long, lYPoint As Long, lIndex As Long
	If Button = 0 Then '确定在移动鼠标的同时没有按下功能键或者鼠标键
	lXPoint = CLng(x / Screen.TwipsPerPixelX) '获得光标的位置，以像素为单位
	lYPoint = CLng(y / Screen.TwipsPerPixelY)
	With List1
		lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint)) '获得光标所在的标题行的索引
		If lIndex < .ListCount Then .TooltipText = .List(lIndex) Else .TooltipText = ""
	End With
		End If
End Sub

2 用LB_SETHORIZONTALEXTENT获得横向滚动条

当向列表中加入的列表项超出了列表的显示范围后，列表并不会出现横向滚动条让你可以通过滚动来浏览项目的全部内容。利用 LB_SETHORIZONTALEXTENT消息可以设置列表框的横向滚动条以及滚动长度。

在 Form1 中加入一个 ListBox 控件，运行程序，可以看到列表中出现了横向滚动条，而且滚动范围正好是列表项的长度代码如下 (我已试验成功):

Option Explicit
Private Type RECT
	Left As Long
	Top As Long
	Right As Long
	bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const LB_SETHORIZONTALEXTENT = &H194
Const DT_CALCRECT = &H400
Public Function ListTextWidth(ByRef lstThis As ListBox) As Long '获取最长项目的象素长度值
	Dim i As Long
	Dim tR As RECT
	Dim lW As Long
	Dim lWidth As Long
	Dim lHDC As Long
	With lstThis.Parent.Font
		.Name = lstThis.Font.Name
		.Size = lstThis.Font.Size
		.Bold = lstThis.Font.Bold
		.Italic = lstThis.Font.Italic
	End With
	lHDC = lstThis.Parent.hDC
	For i = 0 To lstThis.ListCount - 1 '遍历所有的列表项以找到最长的项
		DrawText lHDC, lstThis.List(i), -1, tR, DT_CALCRECT
		lW = tR.Right - tR.Left + 8
		If lW > lWidth Then lWidth = lW
	Next
	ListTextWidth = lWidth '返回最长列表项的长度（像素）
End Function
Private Sub Form_Load()
	Dim astr As String
	Dim i
	Dim L As Long
	For i = 1 To 10: astr = str(i) + "这是真正的长项目" + astr: List1.AddItem astr: Next '加入一个很大的列表项
	L = ListTextWidth(List1)
	SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, L, 0
End Sub

3 用LB_FINDSTRING获得列表中匹配的字符串

有时我们需要列表根据用户敲入的字符串自动调整列表的ListIndex到最接近的列表项，就象VB中动态响应用户输入控件属性的编辑器一样。问题的关键是如何在列表中查找含有指定字符串的列表项，使用LB_FINDSTRING消息可以在列表中查找指定字符串

在 Form1 中加入一个 TextBox 控件和一个 ListBox 控件，并将 List1的 Sorted 属性设置为True。运行程序，在文本框中敲入字符，例如"av" "gm"，列表就会高亮显示相近的列表项。代码如下（已成功）：

Const LB_FINDSTRING = &H18F
Dim ST As String
Private Sub Form_Load()
	For i = 65 To 90: For j = 65 To 90: List1.AddItem Chr(i) + Chr(j): Next: Next '向List中加入列表项
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
	If Len(ST) > 1 Then ST = ""
	If ((KeyAscii > 64 And KeyAscii < 91) Or (KeyAscii > 96 Or KeyAscii < 123)) Then
		Dim L As Long
		ST = ST + Chr(KeyAscii)
		L = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal ST) '注意！当参数4传入的是字符串时，必须用ByVal传递
		If L Then List1.ListIndex = L
	End If
End Sub

4.用LB_FINDSTRING获得列表中匹配的项目

在Win95风格的帮助系统中一般都有一个“索引”页，索引页含有一个文本框和一个列表框，当用户在文本框中输入文字时，下拉列表会动态地显示与文本框中文字最匹配的项目，为用户提供了最大的方便。这种效果在应用程序的帮助系统中很容易实现（只要按照 Win95帮助系统的正常***过程***就可以实现），如果想在应用程序的其它地方实现这种特性就需费一番心思了。

而使用SendMessage函数实现上述特性则非常简单，甚至只需一条语句就足够了，那就是在文本框的Change事件中给列表框发一条LB_FINDSTRING(&H18F）消息，该消息告诉列表框在列表中查找匹配的项目

在发LB_FINDSTRING消息时，wParam参数代表从列表框的哪一个项目后面开始查找，一般情况下该参数可定为-1，表示从List1(0)即第一项开始向后循环查找，lParam则传进欲搜索的字符串（必须采用值传递）。

具体的代码和运行画面与下面的 5.
合并在一起演示。

5.用LB_SETHORIZONTALEXTENT获得水平滚动条

在VB中，列表框控件仅提供垂直滚动条，没有设置水平滚动条的能力，当某些项目的文本宽度较长时，超出列表框宽度部分的文本就无法显示出来，因此，很有必要为ListBox添加一个水平滚动条来方便操作

为添加水平滚动条，只需发一条 LB_SETHORIZONTALEXTENT(&H194)消息给列表框即可。发送消息时，wParam为滚动条的长度（以像素为单位，可通过计算得出准确的长度，上面例2 就是如此的，也可随便给一个数字，如本例的 250），lParam无用。代码如下（已试验成功）：

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const LB_FINDSTRING = &H18F
Public Const LB_SETHORIZONTALEXTENT = &H194
Private Sub Form_Load()
	List1.AddItem "软件"
	List1.AddItem "电脑游戏"
	List1.AddItem "电视机"
	List1.AddItem "电视台"
	List1.AddItem "电脑"
	List1.AddItem "电脑游戏软件"
	SendMessage List1.hwnd, &H194, 250, 0 '为列表框添加水平滚动条
End Sub
Private Sub Text1_Change()
	'注意！当lParam传入的是字符串时，必须用ByVal传递
	List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal Text1.Text)
End Sub

6.高亮显示，用LB_FINDSTRING

在API文本浏览器里，当我们在搜索栏输入任意字母，“可用项”里以该字母开头的项目作为高亮显示以引起我们注意。该项是不是我们所需的象这样的功能一切提供搜索选项的程序都应该具备。以下例子采用SendMessage函数实现这一技术

Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
	Dim i As Integer
	For i = Asc("A") To Asc("Z") '给列表框添加26个字母（大写）
		List1.AddItem Chr$(i)
	Next
	Text1 = "" '令文本框为空
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
	Text1 = "" '按下任意键则令原内容消失
	Text1.SelLength = 1 '限制长度
	Text1.SelText = Chr(KeyAscii) '显示键盘符号
	KeyAscii = 0 '禁止响应
	'ListBox中的项目文本若与文本框的一致则选中(高亮)
	List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text)) '经试，不需CStr函数
End Sub

以上程序适用于单项目为多个字母的查询，但必须注意，在TextBox的KeyPress事件中要作相应的改动

二、SendMessage函数应用（TVM_开头的消息，树形列表控件）

介绍如何利用消息函数来扩展树型列表 TreeView控件的功能。相信对于树型列表控件大家十分的熟悉，典型的应用就是 Windows
资源管理器中的目录列表。而在VB中，树型列表控件包含在Microsoft Windows Common Control 6.0（也可能是5.0，视你的VB或者系统版本而定）中。在Windows API
中，有一系列的以 TVM_ 开头的消息值，这些消息就是扩展树型列表控件所特定的消息值，下面向大家介绍其中的一些应用

1.用TVM_SETBKCOLOR设置背景颜色

首先做如下的定义:

Const TV_FIRST = &H1100
Const TVM_SETBKCOLOR = TV_FIRST + 29(4381)

调用:

Call SendMessage(TreeView1.hwnd, 4381, 0, ByVal RGB(255, 0, 0))

上面的SendMessage调用将TreeView1的背景颜色设置为红色
大家可能注意到了。在上面的 Sendmessage函数定义中，我们将 lParam
定义为 ByVal lParam As Long，而不是象前面的那些范例那样定义为 Any
或者 String类型，关于这个问题，我会在最后的一章中做介绍

2.用TVM_SETITEMHEIGHT设置行高

TVM_SETITEMHEIGHT　消息设定控件的标题行的高度，该消息的定义及调用方法如下：

TVM_SETITEMHEIGHT　消息设定控件的标题行的高度，该消息的定义及调用方法如下：
Const TV_FIRST = &H1100
Const TVM_SETITEMHEIGHT = TV_FIRST + 27
Call SendMessage(TreeView1.hwnd, TVM_SETITEMHEIGHT, 60, 0) '将TreeView1标题行高度设置到60像素高

3.用TVM_HITTEST和TVM_GETITEM设置不同的提示

介绍如何为树型列表控件中的每一个标题设置不同的提示。同 ListBox控件不通，树型列表控件中并没有根据光标位置获得标题行索引的消息，我们需要另外想办法。在TVM类消息中有一个TVM_HITTEST消息，发送该消息可以检测控件表面上的某一点，如果该点位于一个标题上，则返回该标题的句柄。而利用
TVM_GETITEM消息，则可以根据标题句柄返回该标题行的文本。所以结合利用这两个消息可以获取光标所在标题行的标题文本具体的范例代码如下:

Option Explicit
Private Type TPoint
	x As Long
	y As Long
End Type
Private Type TVHITTESTINFO
	pt As TPoint
	flags As Long
	hItem As Long
End Type
Private Type TVITEM
	mask As Long
	HTreeItem As Long
	state As Long
	stateMask As Long
	pszText As Long
	cchTextMax As Long
	iImage As Long
	iSelectedImage As Long
	cChildren As Long
	lParam As Long
End Type
Const TV_FIRST = &H1100
Const TVM_HITTEST = TV_FIRST + 17
Const TVM_GETITEM = TV_FIRST + 12
Const TVHT_ONITEMLABEL = &H4
Const TVIF_TEXT = &H1
Const GMEM_FIXED = &H0
Private Declare Function SendMessageRef Lib "user32" Alias "SendMessageA" (ByVal hwnd As  Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As String, ByVal Source As Long, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes  As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Dim hItemPrv As Long
Private Sub Form_Load()
Dim ndX As Node
	'加入若干Item
	Set ndX = TreeView1.Nodes.Add(, , "R", "Root")
	Set ndX = TreeView1.Nodes.Add("R", tvwChild, "Key1", "Node1")
	Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey1", "SubNode1")
	Set ndX = TreeView1.Nodes.Add("SubKey1", tvwChild, "SubKeys1", "SubNode1")
	Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey2", "SubNode2")
	Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey3", "SubNode3")
	Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey4", "SubNode4")
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
	Dim ptA As TPoint
	Dim tf As TVHITTESTINFO
	Dim tv As TVITEM
	Dim hStr As Long
	Dim hItem As Long
	Dim astr As String * 1024
	Dim bstr
	On Error GoTo errLab
　　	'获得当前光标所在的位置坐标
　　	ptA.x = Int(x / Screen.TwipsPerPixelX)
　　	ptA.y = Int(y / Screen.TwipsPerPixelY)
　　	tf.pt = ptA
　　	tf.flags = TVHT_ONITEMLABEL
　　	'获得光标所在的Item的句柄
　　	hItem = SendMessageRef(TreeView1.hwnd, TVM_HITTEST, 0, tf)
　　	'如果未获得句柄或者同上一次是同一个Item的句柄则退出
　　	If ((hItem <= 0) Or (hItem = hItemPrv)) Then Exit Sub
　　	hItemPrv = hItem
　　	'分配一定的内存空间用以存储Item的标题
　　	hStr = GlobalAlloc(GMEM_FIXED, 1024)
　　	If hStr > 0 Then
　　		tv.mask = TVIF_TEXT '获取标题文本
　　		tv.HTreeItem = hItem 'Item句柄
　　		tv.pszText = hStr
　　		tv.cchTextMax = 1023
　　		'发送TVM_GETITEM获得标题文本
　　		Call SendMessageRef(TreeView1.hwnd, TVM_GETITEM, 0, tv)
　　		'将标题文本拷贝到字符串astr中
　　		CopyMemory astr, hStr, 1024
　　		bstr = Left$(astr, (InStr(astr, Chr(0)) - 1))
　　		TreeView1.ToolTipText = bstr
　　		'释放分配的内存空间
　　		GlobalFree hStr
　　	End If
　　	Exit Sub
errLab:
　　	Resume Next
End Sub

运行上面的程序，当光标在 TreeView1上面移动时，TreeView1的 ToolTips就会根据光标所在的不同标题行而变动