注册 登录
Office中国论坛/Access中国论坛 返回首页

的个人空间 http://www.office-cn.net/?0 [收藏] [复制] [分享] [RSS]

日志

[转]SendMessage函数应用(二)

已有 375 次阅读2008-3-9 19:51 |个人分类:API

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

1、设置树型列表控件的背景颜色
 首先做如下的定义:

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 消息设定控件的标题行的高度,该消息的定义及调用方法如下:

Const TV_FIRST = &H1100
Const TVM_SETITEMHEIGHT = TV_FIRST + 27

Call SendMessage(TreeView1.hwnd, TVM_SETITEMHEIGHT, 60, 0) '将TreeView1标题行高度设置到60像素高

、为树型列表控件中不同的标题行设置不同的提示
 ?介绍如何为树型列表控件中的每一个标题设置不同的提示。同 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就会根据光标所在的不
同标题行而变动。

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-25 04:51 , Processed in 0.067846 second(s), 14 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部