vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB601.10.03
ToolTip & HotTracking in der ListBox

Dieser Tipp zeigt, wie man eine ToolTip-Anzeige mit fixer Position inkl. HotTracking in der ListBox realisieren kann.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.046 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt 

Vor einiger Zeit haben wir Ihnen gezeigt, wie man eine ListBox mit laufender ToolTip-Anzeige erstellen kann, d.h. wird die Maus auf einen ListBox-Eintrag bewegt, wird ein entsprechender ToolTip angezeigt.

Leider wird der ToolTip hierbei immer an der aktuellen Mausposition dargestellt. Vom TreeView-Control z.B. ist man es aber gewohnt, dass der ToolTip exakt über den Eintrag "positioniert" wird und genau diese Funktion realisieren wir heute mit der VB-Standard-ListBox.

Zu berücksichtigen gilt:

  1. Der ToolTip soll nur angezeigt werden, wenn der aktuelle Eintrag unter dem Mauszeiger breiter ist als die ListBox selbst.
  2. Um die Breite abzufragen muss ein evtl. vorhandener vertikaler Scrollbalken berücksichtigt werden
  3. Der ToolTip soll sofort angezeigt werden, wenn der Mauszeiger über den Eintrag bewegt wird (HotTracking)
  4. Der ToolTip soll wieder ausgeblendet werden, wenn der Eintrag mit der Maus angeklickt wird

Erstellen Sie ein neues Projekt und platzieren auf die Form eine ListBox (List1), sowie eine PictureBox (picToolTip) für die Anzeige des ToolTip-Textes.

Option Explicit
 
' zunächst die benötigten API-Deklarationen
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
  ByVal nIndex As Long) As Long
 
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
Private Declare Function SetCapture Lib "user32" ( _
  ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseCapture Lib "user32" () 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 Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_NOPREFIX = &H800
Private Const DT_SINGLELINE = &H20
 
Private Const SM_CXVSCROLL = 2
 
Private Const LB_GETTOPINDEX = &H18E
Private Const LB_GETITEMHEIGHT = &H1A1
' ToolTip-Text anzeigen
Private Sub List1_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
  Dim nTopIndex As Long
  Dim nItemHeight As Long
  Dim i As Long
  Dim nTop As Single
  Dim nIndex As Long
  Dim bInList As Boolean
  Dim R As RECT
  Dim nCount As Long
  Dim bVScroll As Boolean
  Dim nWidth As Long
 
  With List1
    ' Ermitteln des ersten Index der Listbox
    nTopIndex = SendMessage(.hwnd, LB_GETTOPINDEX, 0, 0)
 
    ' Ermitteln der Item-Zeichenhöhe
    nItemHeight = SendMessage(.hwnd, _
      LB_GETITEMHEIGHT, 0, 0) * Screen.TwipsPerPixelY
 
    ' Anzahl sichtbarer Einträge
    nCount = .Height / nItemHeight
    If .Height Mod nItemHeight <> 0 Then nCount = nCount + 1
 
    ' vertikaler Scrollbalken?
    bVScroll = (.ListCount > nCount)
 
    ' Breite der ListBox mit/ohne Scrollbalken
    nWidth = IIf(Not bVScroll, .Width, _
      .Width - GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX)
 
    ' Befindet sich die Maus innerhalb der ListBox?
    If X >= 0 And X <= nWidth And Y >= 0 And Y <= .Height Then
      Call SetCapture(.hwnd)
      bInList = True
    Else
      Call ReleaseCapture
      bInList = False
    End If
  End With
 
  nIndex = -1
  If bInList Then
    ' Ermitteln des Index, über dem der Mauspfeil steht
    nIndex = nTopIndex - 1
    For i = 0 To List1.Height Step nItemHeight
      If i > Y Then Exit For
      nIndex = nIndex + 1
    Next
  End If
 
  ' Gültiger Index?
  With picToolTip
    If nIndex >= 0 And nIndex < List1.ListCount And nIndex <> List1.ListIndex Then
      ' ToolTip nur anzeigen, wenn der aktuelle Eintrag nicht komplett
      ' in der ListBox sichtbar ist
      If TextWidth(List1.List(nIndex)) > nWidth Then
        ' Größe und Position des ToolTip-Controls (picToolTip)
        .Left = List1.Left
        .Top = List1.Top + (nIndex - nTopIndex) * nItemHeight
        .Width = TextWidth(List1.List(nIndex)) + ScaleX(6, vbPixels, ScaleMode)
        .Height = nItemHeight + 4 * Screen.TwipsPerPixelY
 
        ' Text in das Control "zeichnen"
        R.Left = 3
        R.Top = 1
        R.Right = .Width / Screen.TwipsPerPixelX - 1
        R.Bottom = .Height / Screen.TwipsPerPixelY + 1
        .Cls
        DrawText .hdc, List1.List(nIndex), Len(List1.List(nIndex)), R, _
          DT_LEFT Or DT_TOP Or DT_NOPREFIX Or DT_SINGLELINE
 
        ' ToolTip nach oben setzen
        .ZOrder
        .Visible = True
        .Tag = nIndex
      Else
        .Visible = False
      End If
    Else
      .Visible = False
    End If
  End With
End Sub
Private Sub List1_Click()
  ' ToolTip verstecken und List-Eintrag selektieren
  Call ReleaseCapture
  DoEvents
  picToolTip.Visible = False
End Sub

Dieser Tipp wurde bereits 1.046 mal aufgerufen.

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-2021 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