'***************************
'自由奔腾 wgscd
'QQ:153964481
'website:http://www.topds.com
'****************************
SendMessage函数巧应用(一)
在Windows编程中,向文本框控件、列表控件、按钮控件等是我们最常接触的控件了。但是在VB中这些控件
有时
无法实现我们的需要。在这时,我们只要简单的利用Windows API函数就可以扩充这些控件的功能了。
顾名思义,SendMessage函数就是向窗口(这里的窗口指的是向按钮、列表框、编辑框等具有hWnd属性的控
件)
发送消息的函数,该函数的定义如下:
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分别定义传递到窗口的附加参数。而
在Windows
系统的很多消息中,有一些不仅仅是提供一个窗口消息那么简单。它们可以控制窗口的动作和属性。下面我将
分次向
向大家介绍SendMessage函数在扩充基本控件功能方面的应用。
一、列表(ListBox)控件
在Windows中,有一系列的以LB_开头的列表消息,这里介绍的就是利用LB消息控制的ListBox的应用
1、使列表中光标移动到不同的列表项上有不同的提示(ToolTip)
在列表框控件中有一个ToolTipText属性,该属性决定了当光标在列表框上移动时出现的提示文字。但是如
何使得
当光标在不同的列表项上移动时的提示文字也不同呢?问题的关键是要知道在光标移动时光标所在的列表项的
索引,使
用SendMessage函数发送LB_ITEMFROMPOINT消息就可以获得。下面是程序范例:
Option Explicit
Const LB_ITEMFROMPOINT = &H1A9
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
Private Sub Form_Load()
Dim i
For i = 1 To 200
List1.AddItem Str(i) + " Samples in this list is " + Str(i)
Next i
End Sub
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)
lYPoint = CLng(Y / Screen.TwipsPerPixelY)
'
With List1
'获得 光标所在的标题行的索引
lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, _
ByVal ((lYPoint * 65536) + lXPoint))
'将ListBox的Tooltip设置为该标题行的文本
If (lIndex >= 0) And (lIndex <= .ListCount) Then
.ToolTipText = .List(lIndex) 'Return the text = .list(lIndex)
Else
.ToolTipText = ""
End If
End With
End If
End Sub
首先在Form1中加入一个ListBox控件,然后再将上面的代码加入到Form1的代码窗口中。运行程序,当光标
在
列表中移动时,可以看到根据光标所在的不同的列表项,提示文字也不相同。
2、向列表中加入横向滚动条使得可以浏览长列表项
当向列表中加入的列表项超出了列表的显示范围后,列表并不会出现横向滚动条让你可以通过滚动来浏览
项目
的全部内容。利用LB_SETHORIZONTALEXTENT消息可以设置列表的横向滚动条以及滚动长度。下面是范例程序:
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
End If
Next i
'返回最长列表项的长度(像素)
ListTextWidth = lWidth
End Function
Private Sub Form_Load()
Dim astr As String
Dim i
Dim l As Long
l = List1.FontSize * 20 / Screen.TwipsPerPixelX
For i = 1 To 10
astr = astr + "我们This is a very long item " + Str(i)
Next i
List1.AddItem astr + "aaa"
'加入一个很厂的列表项
l = ListTextWidth(List1)
SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, l, 0
End Sub
首先在Form1中加入一个ListBox控件,然后再将上面的代码加入到Form1的代码窗口中。运行程序,可以
看到列表中出现了横向滚动条,而且滚动范围正好是列表项的长度。
3、使列表可以响应用户击键
有时我们需要列表根据用户的敲入字符串自动调整列表的ListIndex到最接近的列表项,就象VB中动态感应
用户输入控件属性的编辑器一样。问题的关键是如何在列表中查找含有指定字符串的列表项,使用
LB_FINDSTRING
消息可以在列表中查找指定字符串。下面是范例:
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
Const LB_FINDSTRING = &H18F
Dim astr As String
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim l As Long
astr = astr + Chr(KeyAscii)
l = SendMessageStr(List1.hwnd, LB_FINDSTRING, -1, astr)
If l Then
List1.ListIndex = l
End If
End Sub
Private Sub Form_Load()
'向List中加入列表项
For i = 65 To 85
For j = 65 To 85
List1.AddItem Chr(i) + Chr(j)
Next j
Next i
End Sub
Private Sub List1_DblClick()
'清除原来的查找字符串
astr = ""
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
'如果按下的是字母键就将击键消息传递到Form1
If ((KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 _
Or KeyAscii <= 122)) Then
KeyAscii = 0
End If
End Sub
首先在Form1中加入一个ListBox控件,然后再将上面的代码加入到Form1的代码窗口中。并将List1的
Sorted属性
设置为True。运行程序,在列表中敲入字符,例如“av” “gm”,列表就会高亮显示相近的列表项,双击列表
就可以
清除原来的输入。
SendMessage函数巧应用(二)
在上一篇文章中我向大家介绍了关于ListBox类控件消息的应用,在这一章我将向大家介绍如何利用消息操
控
TextBox类控件。
1、获得光标所在的行和列
一般的比较完善的文本编辑器一般都有在状态栏中显示当前光标所在行和列的功能。利用SendMessage向
TextBox
控件发送编辑控件类型消息。也可以实现这样的功能。下面首先来看程序,然后再分析。
首先在VB中建立一个新工程,并在Form1中加入一个TextBox控件和两个Label控件。将TextBox控件的
MultiLine
属性设置为True。然后在Form1的代码窗口中加入如下代码:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SendMessageByRef Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, wParam As Long, _
lParam As Long) As Long
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB
Const EM_GETLINE = &HC4
Const EM_GETSEL = &HB0
Dim iLineX, iLineY As Long
Sub GetCurPos(txtA As TextBox)
Dim l, l1, l2 As Long
Dim astr As String * 256
l = SendMessage(txtA.hwnd, EM_LINEINDEX, -1, 0)
iLineY = SendMessage(txtA.hwnd, EM_LINEFROMCHAR, l, 0)
SendMessageByRef txtA.hwnd, EM_GETSEL, l1, l2
iLineX = l1 - l
Label1.Caption = "列:" + Str(iLineX)
Label2.Caption = "行:" + Str(iLineY)
End Sub
Private Sub Form_Load()
Dim iFile
Dim astr As String
Label1.Height = 300: Label2.Height = 300
Text1.Left = 0: Text1.Top = 0
Text1.Text = ""
Label1.Caption = ""
Label2.Caption = ""
iFile = FreeFile
Open "C:\windows\readme.txt" For Input As #iFile
Do
Line Input #iFile, astr
Text1.Text = Text1.Text + astr + vbCrLf
Loop Until EOF(iFile)
Close iFile
End Sub
Private Sub Form_Resize()
Label1.Top = Me.ScaleHeight - 300
Label2.Top = Me.ScaleHeight - 300
Label1.Left = 0: Label2.Left = 1200
Label1.Width = 1200
Label2.Width = 1200
Text1.Width = Me.ScaleWidth
Text1.Height = Me.ScaleHeight - Label1.Height
End Sub
Private Sub Text1_Click()
GetCurPos Text1
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
GetCurPos Text1
End Sub
在运行程序前,确保在你的硬盘上有 c:\windows\readme.txt 这个文件。否则程序会出错。然后运行
程序。当在编辑文本时,可以看到在窗口底部可以显示当前光标所在的行、列值。
在上面的程序中。我们首先发送EM_LINEINDEX消息,发送该消息可以返回某一行的第一个字符在整个
文本控件中的位置,如果wParam参数设置为-1,则返回当前行的字符位置。然后发送EM_LINEFROMCHAR,发
送该消息可以根据参数wParam指定的字符位置返回该字符所在的行号,文本第一行的位置为0。这样使用这
两个消息就获得当前光标所在的行号。要取得列号,首先发送EM_GETSEL消息,发送该消息返回当前被选中
文本的起始位置,如果没有文本被选中,则返回当前光标所在字符在文本中的位置。由于上面的EM_LINEINDEX
消息返回的是当前行的第一个字符在文本中的位置。所以将两值相减,就是光标所在字符的列位置。
在上面的程序中,如果你的文本中有中文字符的话,当你的光标在中文字符中移动一个位置,你会看到
标签中的列位置增加了2,这是由于SendMessage发送的消息所得到的结果是不支持中文的,它将一个中文字
算做两个字符。这也算是程序中的一个Bug吧(这也就是为什么我要使用EM_GETSEL消息而不直接使用TextBox
控件的SelStart属性来获取光标所在字符位置了,因为如果使用SelStart返回的值将一个中文算一个字符,同
EM_LINEINDEX返回值相减有可能得到负值
2、获得文本控件中整行文本
利用EM_GETLINE消息我们可以获得文本控件中某一行的文本。具体的范例如下:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB
Const EM_GETLINE = &HC4
Private Sub Text1_Click()
Dim astr As String
Dim l, iLineY As Long
astr = Space(1024)
l = SendMessage(Text1.hwnd, EM_LINEINDEX, -1, 0)
iLineY = SendMessage(Text1.hwnd, EM_LINEFROMCHAR, l, 0)
l = SendMessageStr(Text1.hwnd, EM_GETLINE, iLineY, ByVal astr)
Me.CurrentX = 30: Me.CurrentY = 30
Me.Print "该行包含文本长度:" + Str(l)
Text2.Text = Trim(astr)
End Sub
要运行上面的程序,首先你要在Form中加入两个TextBox控件,并将Text1的MultiLine属性设置为True。然
后
运行程序,在text1中点击鼠标,Text2中就会显示光标所在行的文本。
3、其它消息
下面介绍一些控制TextBox控件行为的消息
EM_GETFIRSTVISIBLELINE
发送EM_GETFIRSTVISIBLELINE消息可以获得文本控件中处于可见位置的最顶部的文本所在的行。如果消息
处理
成功,将返回该行的索引,以0为基数。
EM_LINESCROLL
发送该消息可以控制textBox水平或垂直滚动。参数wParam指定水平滚动的字符数。参数lParam指定垂直滚
动的
行数,定义以及调用方法如下:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Const EM_LINESCROLL = &HB6
SendMessage Text1.hwnd, EM_LINESCROLL, 5, ByVal 1 '将Text1中的文本向下滚动1行,向右滚动5个
字符
EM_SETREADONLY
发送该消息可以设置文本控件是否具有只读属性,如果将SendMessage参数wParam设置为True,则控件具有
只读
属性,否则控件可读写。范例如下:
Const EM_SETREADONLY = &HCF
SendMessage Text1.hwnd, EM_SETREADONLY, True, 0 '设置text1为只读
EM_UNDO
发送该消息将使文本控件回复上一次的操作,相当于运行时在文本控件的右键菜单中选择“撤销”操作。
SendMessage函数巧应用(三)
在这一期的SendMessage函数应用中,我将向大家介绍如何利用消息函数来扩展树型列表(TreeView)控件的
功能
相信对于树型列表控件大家十分的熟悉,典型的应用就是Windows资源管理器中的目录列表。而在VB中,树型列
表控件
包含在Microsoft Windows Common Control 6.0(页可能是5.0,视你的VB或者系统版本而定)中。在Windows
API中,
有一系列的以TVM_ 开头的消息值,这些消息就是扩展树型列表控件所特定的消息值,下面向大家介绍其中的一
些应用
1、设置树型列表控件的背景颜色
首先做如下的定义:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Const TV_FIRST = &H1100
Const TVM_SETBKCOLOR = TV_FIRST + 29
然后再做如下调用:
Call SendMessage(TreeView1.hwnd, TVM_SETBKCOLOR, 0, RGB(255, 0, 0))
上面的SendMessage调用将TreeView1的背景颜色设置为红色。
大家可能注意到了。在上面的Sendmessage函数定义中,我们将lParam定义为 ByVal lParam As Long,而
不是象前
面的那些范例那样定义为Any或者String类型,关于这个问题,我会在最后的一章中做介绍。
2、设置树型列表控件标题行高度
利用TVM_SETITEMHEIGHT消息可以设定控件的标题行的高度,该消息的定义及调用方法如下:
定义:
Const TV_FIRST = &H1100
Const TVM_SETITEMHEIGHT = TV_FIRST + 27
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
调用:
Call SendMessage(TreeView1.hwnd, TVM_SETITEMHEIGHT, 60, 0)
上面的代码将TreeView1的标题行高度设置到60像素高
3、为树型列表控件中不同的标题行设置不同的提示
在第一期的ListBox控件介绍中,我向大家介绍了如何为列表中的每一个标题行设置不同的提示(ToolTips)
,在这里
为要向大家介绍如何为树型列表控件中的每一个标题设置不同的提示。
同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就会根据光标所在的不同标题行
而变动。
以上程序在Win98、Win2000,VB6下编写运行通过。
当然在”。NET“环境下也可以使用。
前面的“QQ消息轰炸机”就是利用这个的,