请问编辑窗体时，设置controlTtipText 的属性的时候如何给提示的文字分行？

gotop 发表于 2007-6-11 21:15:00

wylong 发表于 2007-6-13 15:32:00

VB5 以后的 VB 版本都有提供一个属性 -- ToolTipText，目的是让使用者在执行阶段，鼠标在物件上徘徊约一秒时，就将该物件的提示字串显示在该物件下面的一个小长方形中，以协助使用者做输入动作。 有时候说明字串太长了，于是就有人想将提示字串分行显示，而且自然而然的使用 vbNewLine (=vbCrLf 或 =vbCr ) 来换行，因为根据以往的经验，VB都是这样做换行的，可是这一次很多人都踢到铁板了！ VB 用来显示 ToolTipText 的提示框，其实是一个文字框，而且 MultiLine 属性并没有设为 True，您可以自己用一个单行式的文字框来做测试，就算您用 vbCrLf 来换行也不会有作用的！ 既然 VB 提供的 Default 功能不能满足我们的需求，而我们又想提供使用者多行式的提示框，那要怎么办呢？其实也不难，我们自己动手 DIY 一下就有了，而且程序码也不长！ '首先在 Form 上放一个 Timer (如果需要的话)，以便于叫出突现式说明框 Private Function TimeOut(pInterval As Single) Dim sngTimer As Single sngTimer = Timer Do While Timer < sngTimer + pInterval DoEvents Loop End Function '然后在 Form 上放一个 Label，取名为 lblToolTip，在 MouseMove 中加入以下程序： Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lbltooltip.Visible = False End Sub '在您想显示说明框的物件加入以下程序码： ( Textbox, listbox etc. ) Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) TimeOut 0.3 '鼠标移到物件上多久后,要显示提示框 lbltooltip.Caption = "大家好 !!" & vbCrLf & "" & vbCrLf & _ "您目前看到的黄色标签" & vbCrLf & "是一个多行式的提示框" lbltooltip.Left = Text1.Left + lbltooltip.Width lbltooltip.Top = Text1.Top + Text1.Height lbltooltip.Visible = True End Sub

wylong 发表于 2007-6-13 15:42:00

'如果上面的方法不合意: '看这段代码:Public Const TTS_ALWAYSTIP = &H1 Public Const TTS_NOPREFIX = &H2 Public Const TTS_BALLOON = &H40 Public Const CW_USEDEFAULT = &H80000000 Public Const WS_POPUP = &H80000000 Public Const WM_USER = &H400 ' 提示的消息 Public Const TTM_SETDELAYTIME = (WM_USER + 3) Public Const TTM_ADDTOOL = (WM_USER + 4) Public Const TTM_SETTIPBKCOLOR = (WM_USER + 19) Public Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20) Public Const TTM_GETTIPBKCOLOR = (WM_USER + 22) Public Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23) Public Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)Public Const TTDT_AUTOMATIC = 0 Public Const TTDT_RESHOW = 1 Public Const TTDT_AUTOPOP = 2 Public Const TTDT_INITIAL = 3Public Const TTF_IDISHWND = &H1 Public Const TTF_CENTERTIP = &H2 Public Const TTF_SUBCLASS = &H10Public Type TOOLINFO       cbSize As Long       uFlags As Long       hWnd As Long       uId As Long       cRect As RECT       hinst As Long       lpszText As String End TypePublic 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 Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDeclare Sub InitCommonControls Lib "comctl32.dll" ()Public bCreated  As Boolean, hTT As Long Public hCreated() As LongPublic Sub CreateTTWindow(hParent As Long, Optional bBalloon As Boolean = False)   Dim h     As Long, lStyle       As Long   lStyle = TTS_NOPREFIX Or TTS_ALWAYSTIP   InitCommonControls   If bBalloon Then lStyle = lStyle Or TTS_BALLOON   hTT = CreateWindowEx(0, "tooltips_class32", 0, lStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hParent, 0, App.hInstance, 0)   If hTT = 0 Then MsgBox "错误！无法建立工具提示窗口！", vbCritical, "错误"   If Not bCreated Then         ReDim hCreated(0)         bCreated = True   Else         ReDim Preserve hCreated(UBound(hCreated) + 1)   End If   hCreated(UBound(hCreated)) = hTT End SubPublic Sub SetToolTip(objTT As Object, sTipText As String, Optional BKColor As Long = &HEEFFFF, Optional TxtColor As Long = vbBlack, Optional MaxWidth As Long = 300, Optional DelayTime As Long = 500, Optional VisibleTime As Long = 2000, Optional bCenter As Boolean = False)     Dim TI     As TOOLINFO     With TI         GetClientRect objTT.hWnd, .cRect         .hWnd = objTT.hWnd         .uFlags = TTF_IDISHWND Or TTF_SUBCLASS         If bCenter Then                 .uFlags = .uFlags Or TTF_CENTERTIP         End If         .uId = objTT.hWnd         .lpszText = sTipText         .cbSize = Len(TI)     End With     SendMessageLong hTT, TTM_SETMAXTIPWIDTH, 0, MaxWidth     SendMessageLong hTT, TTM_SETDELAYTIME, TTDT_INITIAL, DelayTime     SendMessageLong hTT, TTM_SETDELAYTIME, TTDT_AUTOPOP, VisibleTime     SendMessageLong hTT, TTM_SETTIPTEXTCOLOR, TxtColor, 0&     SendMessageLong hTT, TTM_SETTIPBKCOLOR, BKColor, 0&     SendMessage hTT, TTM_ADDTOOL, 0, TI End SubPublic Sub DestroyTT()   If Not bCreated Then Exit Sub   Dim i     As Integer   For i = 0 To UBound(hCreated)           DestroyWindow hCreated(i)   Next End Sub'使用方法: Form_Load里先CreateTT '然后把需要的控件统统SetTooltip '在 Form_Unload里DestoryTT '支持换行!

gotop 发表于 2007-6-13 19:19:00

哈哈~~谢谢楼上的兄弟文章讲得十分详细为什么我没搜索到呢，奇怪

页: [1]

明经CAD社区's Archiver

请问编辑窗体时，设置controlTtipText 的属性的时候如何给提示的文字分行？