应用实例'This project needs a ListBox, named List1 and a TextBox, named Text1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Add some items to the listbox
With List1
.AddItem "Computer"
.AddItem "Screen"
.AddItem "Modem"
.AddItem "Printer"
.AddItem "Scanner"
.AddItem "Sound Blaster"
.AddItem "Keyboard"
.AddItem "CD-Rom"
.AddItem "Mouse"
End With
End Sub
Private Sub Text1_Change()
'Retrieve the item's listindex
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub
【VB声明】
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
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
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
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像素高
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
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
注释:获得光标所在的Item的句柄
hItem = SendMessageRef(TreeView1.hwnd, TVM_HITTEST, 0, tf)
注释:如果未获得句柄或者同上一次是同一个Item的句柄则退出
If ((hItem <= 0) Or (hItem = hItemPrv)) Then Exit 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”,列表就会高亮显示相近的列表项,双击列表就可以
清除原来的输入。
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
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 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
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函数在扩充基本控件功能方面的应用。
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的代码窗口中。运行程序,当光标在
列表中移动时,可以看到根据光标所在的不同的列表项,提示文字也不相同。
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
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)
?hWnd
Identifies the window whose window procedure will receive the message. If this parameter is HWND_BROADCAST, the message is sent to all top-level windows in the system, including disabled or invisible unowned windows, overlapped windows, and pop-up windows; but the message is not sent to child windows.
'This project needs a ListBox, named List1 and a TextBox, named Text1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Add some items to the listbox
With List1
.AddItem "Computer"
.AddItem "Screen"
.AddItem "Modem"
.AddItem "Printer"
.AddItem "Scanner"
.AddItem "Sound Blaster"
.AddItem "Keyboard"
.AddItem "CD-Rom"
.AddItem "Mouse"
End With
End Sub
Private Sub Text1_Change()
'Retrieve the item's listindex
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub
简介一下先
【VB声明】
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