VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 1579|回复: 7

[求助] 下面代码,有句柄的可以显示tooltiptext,无句柄的label怎么处理呢?

[复制链接]
发表于 2018-1-21 08:33:37 | 显示全部楼层 |阅读模式
本帖最后由 bruly 于 2018-1-21 08:41 编辑

下面代码是给控件添加气泡的,但条件是需要该控件有句柄。请问没有句柄的如何处理呢?
找到了处理办法的地址有几处,但都下载不了:地址1:http://www.newxing.com/Code/VB/jiemian/ToolTip_174.html#download ;地址2: http://download.csdn.net/download/gsc11111/1731233

有句柄的控件冒泡的方法:
1、窗体代码:
     此处以Text1为例子,需要在窗体上建立Text1控件。
  1. Option Explicit
  2. Dim Tooltip As New clsTooptip
  3. Private Sub Form_Load()
  4.     '气泡应用于哪个控件,得要有Hwnd(句柄 )
  5.     Set Tooltip.ParentControl = Text1
  6.     '气泡标题(不允许换行/字体粗体)
  7.     Tooltip.ToolTipTitle = "气泡标题"
  8.     '气泡内容(允许换行)
  9.     Tooltip.ToolTipText = "气泡内容" & vbCrLf & "123"
  10.     '创建气泡
  11.     Tooltip.Create
  12. End Sub
复制代码


2、类模版代码:
     注意把类模版的名称改为:clsTooptip
  1. Option Explicit
  2.                   
  3. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  4. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long '创建窗口
  5. 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 '发出消息
  6. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  7. Private Const WM_USER = &H400
  8. Private Const CW_USEDEFAULT = &H80000000
  9.                   
  10. Private Type RECT
  11.     Left As Long
  12.     Top As Long
  13.     Right As Long
  14.     Bottom As Long
  15. End Type
  16.                   
  17. Private Const TTS_NOPREFIX = &H2
  18. Private Const TTF_TRANSPARENT = &H100
  19. Private Const TTF_CENTERTIP = &H2
  20. Private Const TTM_ADDTOOLA = (WM_USER + 4)
  21. Private Const TTM_ACTIVATE = WM_USER + 1
  22. Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
  23. Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
  24. Private Const TTM_SETTITLE = (WM_USER + 32)
  25. Private Const TTS_BALLOON = &H40
  26. Private Const TTF_SUBCLASS = &H10
  27. Private Const TOOLTIPS_CLASSA = "tooltips_class32"
  28.                   
  29. Private Type TOOLINFO
  30.     lSize As Long
  31.     lFlags As Long
  32.     lHwnd As Long
  33.     lId As Long
  34.     lpRect As RECT
  35.     hInstance As Long
  36.     lpStr As String
  37.     lParam As Long
  38. End Type
  39.                   
  40. Private TTTitle As String
  41. Private TTParentControl As Object
  42. Private TTStyle As TTStyleEnum
  43.                   
  44. Public Enum TTStyleEnum
  45.     TTStandard
  46.     TTBalloon
  47. End Enum
  48.                   
  49. Private hToolTipHwnd As Long
  50. Private TI As TOOLINFO

  51. Public Function Create() As Boolean                                             '创建气泡函数
  52.     Dim lpRect As RECT
  53.     DestroyWindow hToolTipHwnd
  54.     '建立tooltip窗口
  55.     hToolTipHwnd = CreateWindowEx(0, TOOLTIPS_CLASSA, vbNullString, TTS_BALLOON, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, TTParentControl.hwnd, 0, App.hInstance, 0)
  56.     GetClientRect TTParentControl.hwnd, lpRect
  57.     '设置tooltip
  58.     With TI
  59.         .lFlags = TTF_SUBCLASS
  60.         .lHwnd = TTParentControl.hwnd
  61.         .lId = 0
  62.         .hInstance = App.hInstance
  63.         .lpRect = lpRect
  64.     End With
  65.     SendMessage hToolTipHwnd, TTM_ADDTOOLA, 0, TI
  66.     '给tooltip加上标题
  67.     SendMessage hToolTipHwnd, TTM_SETTITLE, 0, ByVal TTTitle
  68. End Function
  69.                   
  70. Public Property Set ParentControl(ByVal vData As Object) '确定tooltip对象(要求有hwnd的控件)
  71.     Set TTParentControl = vData
  72. End Property
  73.                   
  74. Public Property Let ToolTipTitle(ByVal vData As String) '设置tooltip的标题
  75.     TTTitle = vData
  76.     SendMessage hToolTipHwnd, TTM_SETTITLE, 0, ByVal TTTitle
  77. End Property
  78.                   
  79. Public Property Let ToolTipText(ByVal vData As String) '设置tooltip的文本(支持多行)
  80.     TI.lpStr = vData
  81.     SendMessage hToolTipHwnd, TTM_UPDATETIPTEXTA, 0, TI
  82. End Property
复制代码
1.png
发表于 2018-1-22 16:23:19 | 显示全部楼层
.lprect 指定Label区域         .lprect.left = label1.left ,.lprect.top = label1.top ,.lprect.right = label1.left +label1.width, .lprect.bottom =  label1.top + label1.height

如果label在form上则,form的scalemode 设为vbpixel,Label放picture上时将picture的scalemode设为vbpixel

评分

参与人数 1威望 +8 收起 理由
bruly + 8 很给力,我马上按您所说的去尝试

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2018-1-21 19:30:35 | 显示全部楼层
    With TI
        .lFlags = TTF_SUBCLASS
        .lHwnd = TTParentControl.hwnd
        .lId = 0
        .hInstance = App.hInstance
        .lpRect = lpRect
    End With

如果是Label等控件,其实是绘制在Form上的, .lHwnd设为Form的hwnd,.lprect设为Label的区域即可,不过这个类模块你要修改过才可以

评分

参与人数 1威望 +7 人气 +1 收起 理由
bruly + 7 + 1 很给力

查看全部评分

回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2018-1-21 21:43:38 | 显示全部楼层
本帖最后由 bruly 于 2018-1-21 21:48 编辑
jy4977596491 发表于 2018-1-21 19:30
With TI
        .lFlags = TTF_SUBCLASS
        .lHwnd = TTParentControl.hwnd


无句柄的Label,如何确定其Rect区域,是不是就是它的left、top、width\height等数据?我马上去试,再次万分感谢~
回复 支持 反对

使用道具 举报

 楼主| 发表于 2018-1-21 22:22:16 | 显示全部楼层
本帖最后由 bruly 于 2018-1-22 08:11 编辑
jy4977596491 发表于 2018-1-21 19:30
With TI
        .lFlags = TTF_SUBCLASS
        .lHwnd = TTParentControl.hwnd


label的rect(label1.width-label1.left,label.height-label1.top) 不知道如何用于此处,我想到了另一个折中方法,但是行不通:
在label移动事件中,增加一个机动的有句柄的控件,鼠标移到哪儿,该新增控件就到哪,然后大小位置也与label相同。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2018-1-21 22:57:19 | 显示全部楼层
本帖最后由 bruly 于 2018-1-22 09:18 编辑

老师好,估计是我笨,怎么尝试,结果发现按您的思路去处理了,但无句柄的气泡还是显示不出来。
我发现不成功的原因,有可能是label放在picture1上,遮盖住了母窗体ME。通过尝试发现:
     原句柄 用me.hwnd,区域用picture1的区域,label的位置在picture1上面。根据您的意思,当鼠标移动到picture1区域包含label上面时,都会显示气泡,离开picture1区域就不会。
但事实是,发现在picture1区域不显示,离开picture1区域,在me上面才会显示。
回复 支持 反对

使用道具 举报

发表于 2018-1-22 16:25:05 | 显示全部楼层
label放form上时.lHwnd设为Form的hwnd,放picture时设为picture的hwnd
回复 支持 反对

使用道具 举报

 楼主| 发表于 2018-1-22 18:00:10 | 显示全部楼层
本帖最后由 bruly 于 2018-1-22 18:28 编辑
jy4977596491 发表于 2018-1-22 16:25
label放form上时.lHwnd设为Form的hwnd,放picture时设为picture的hwnd


通过反复测试,情况向老师汇报如下:
    1、我按您刚才所说的把对应的form的scalemode 设为vbpixel,或是picture的scalemode设为vbpixel,
   (我发上文之前用的是: / Screen.TwipsPerPixelX ,没有更改scalemode,选项是2)

    之后结果和我原来的操作是一样的,都不太灵便:
            在label上可以显示气泡;但如果有多个label在这个控件上,当鼠标移动到第一个label1(0)上,
     我要的:显示"1", 移动到第二个label1(1)上,我要显示"2"……  ,
     实际上:显示1后,移动到第二个,要隔很久才会显示2,中间停留的时间有好几秒钟,正常的是只要移走了就会消失气泡的。
     所以我一直说没有做到。但也发现是自己表达不够明确:正确的说法是,label可以显示气泡了,但这些label都在同一个控件中,那么鼠标在label之间来回移动,气泡不会及时更换或消失,而是停留很久才会显示,而这影响了效果。
  
2、我思考原因:
     这些label都在同一个控件上,这个控件上显示了气泡,不管鼠标如何在这个控件上移动,气泡是不会消失的,除非判断鼠标不在某个label上了,就消除气泡。  但如何消除,我用了DestroyWindow函数,但有两个问题,一个是,消除的时机怎么定(在同一个控件下在label之间移动,既要及时显示气泡,又要删除原气泡,不知道如何把握时机),二个是如何消除(DestroyWindow + 句柄即可,但会把整个控件都删除掉,而且该句柄是所有label的同有的控件句柄,删除后控件上的一切都没了。)
     再次感谢老师的热心肠付出,好人好运~!
   
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2018-8-15 08:51

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表