vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 2.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Controls · TextBox & RichTextBox   |   VB-Versionen: VB604.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 OtterBewertung:     [ Jetzt bewerten ]Views:  12.475 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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

    Dieser Tipp wurde bereits 12.475 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Aktuelle Diskussion anzeigen (2 Beiträge)

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!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.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel