Rubrik: Controls · TextBox & RichTextBox | VB-Versionen: VB6 | 04.12.09 |
Automatischer ToolTip für die TextBox Kann der Text in einer TextBox nicht vollständig angezeigt werden, weil die TextBox in der Breite zu klein ist, wird dieser automatisch als ToolTip angezeigt. | ||
Autor: Dieter Otter | Bewertung: | Views: 17.855 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Heute stellen wir Ihnen eine Funktion vor, die es ermöglicht, überlange Texte in einer TextBox als ToolTip anzuzeigen. Der Tipp funktioniert hierbei sowohl für eine normale einzeilige TextBox, als auch für eine MultiLine-TextBox. Bei einer MultiLine-TextBox macht das Ganze aber nur Sinn, wenn kein vertikaler Scrollbalken eingeblendet wird, sondern nur der horizontale Scrollbalken.
Fügen Sie nachfolgenden Code in ein Modul ein:
Option Explicit ' benötigte API-Deklarationen Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetCursorPos Lib "user32" ( _ ByRef lpPoint As POINTAPI) As Long Private Declare Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function ScreenToClient Lib "user32" ( _ ByVal hWnd As Long, _ ByRef lpPoint As POINTAPI) As Long Private Declare Function GetClientRect Lib "user32" ( _ ByVal hWnd As Long, _ ByRef lpRect As RECT) As Long Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByRef lParam As Any) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As Long Private Declare Function SetRect Lib "user32" ( _ lpRect As RECT, _ ByVal X1 As Long, _ ByVal Y1 As Long, _ ByVal X2 As Long, _ ByVal Y2 As Long) As Long 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 ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Const WM_GETFONT As Long = &H31 Private Const DT_CALCRECT = &H400 Private Const DT_SINGLELINE = &H20 Private Const EM_CHARFROMPOS = &HD7 Private Const EM_LINEINDEX = &HBB Private Const EM_LINELENGTH = &HC1
' autom. ToolTip-Anzeige überlanger Textzeilen Public Sub TextBox_SetAutoToolTip(ByRef oTextBox As TextBox) Dim p As POINTAPI Dim hWnd As Long Dim nLine As Long Dim nStart As Long Dim nLen As Long Dim sLine As String Dim r As RECT Dim nDC As Long Dim hFont As Long Dim nWidth As Long ' Prüfen, ob sich der Mauszeiger auf der TextBox befindet hWnd = oTextBox.hWnd GetCursorPos p If WindowFromPoint(p.X, p.Y) = hWnd Then ' aktuelle Zeile ermitteln ScreenToClient hWnd, p nLine = SendMessage(hWnd, EM_CHARFROMPOS, 0&, ByVal Dword(CInt(p.Y), CInt(p.X))) nLine = CLng(nLine \ &H10000) ' Zeileninhalt ermitteln nStart = SendMessage(hWnd, EM_LINEINDEX, nLine, ByVal 0&) nLen = SendMessage(hWnd, EM_LINELENGTH, nStart, ByVal 0&) sLine = Mid$(oTextBox.Text, nStart + 1, nLen) ' Größe der TextBox GetClientRect hWnd, r nWidth = r.Right - r.Left ' Größe der Texzeile ermitteln nDC = GetDC(hWnd) hFont = SendMessage(hWnd, WM_GETFONT, 0, ByVal 0&) hFont = SelectObject(nDC, hFont) SetRect r, 0, 0, 0, 0 DrawText nDC, sLine, -1, r, DT_CALCRECT Or DT_SINGLELINE If r.Right < nWidth Then ' kein ToolTip anzeigen sLine = "" End If ' Ressourcen wieder freigeben SelectObject nDC, hFont ReleaseDC hWnd, nDC ' ToolTip aktualisieren With oTextBox If .ToolTipText <> sLine Then .ToolTipText = sLine End If End With End If End Sub
' Hilfsfunktion Private Function Dword(ByVal Low As Integer, ByVal High As Integer) As Long Dim TmpLW As String, TmpHW As String TmpLW = String(4 - Len(Hex(Low)), "0") & Hex(Low) TmpHW = String(4 - Len(Hex(High)), "0") & Hex(High) Dword = CLng("&H" & TmpLW & TmpHW) End Function
Aufrufbeispiel:
Platzieren Sie auf die Form zwei TextBox-Controls:
- TextBox "Text1"
- TextBox "Text2" mit MultiLine=True und ScrollBars=1-Horizontal
Im Form_Load Ereignis füllen wir die TextBox-Controls:
Private Sub Form_Load() Text1.Width = 2850 Text1.Text = "Dies ist eine überlange Eingabe, die innerhalb " & _ "der TextBox nicht vollständig angezeigt wird." Text2.Width = 2850 Text2.Height = 1000 Text2.Text = "Zeile1" & vbCrLf & _ "Dies ist eine überlange Eingabe, die innerhalb der " & _ "TextBox nicht vollständig angezeigt wird." & vbCrLf & _ "Zeile 3" End Sub
So... und wenn der User dann den Mauszeiger auf die TextBox bewegt, soll der überlange Text als ToolTip angezeigt werden:
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Text ggf. als ToolTip anzeigen TextBox_SetAutoToolTip Text1 End Sub
Private Sub Text2_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Textzeile unter dem Mauszeiger ggf. als ToolTip anzeigen TextBox_SetAutoToolTip Text2 End Sub