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:
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 Dieser Tipp wurde bereits 17.880 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |