Private Sub Datei1_MouseMove(Index As Integer, Button As Integer, Shift As _
  Integer, x As Single, y As Single)
    ' Mit Hilfe des ermittelten Index, wird der Dateiname an ToolTip übergeben
    Datei1(glngFileList).ToolTipText = Datei1(glngFileList).List( _
      FileListBoxHitTest(Datei1(glngFileList), x, y))
End Sub
 
'Übergibt den unter dem Mauszeiger befindlichen Index
Public Function FileListBoxHitTest(FileListBox As FileListBox, ByVal x As _
  Single, ByVal y As Single) As Long
  Dim nXPoint As Long
  Dim nYPoint As Long
  Dim nIndex As Long
 
  nXPoint = x / Screen.TwipsPerPixelX
  nYPoint = y / Screen.TwipsPerPixelY
 
  With FileListBox
    'Hier wird der Index(Dateiname) unter dem Mauszeiger ermittelt
    nIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, nYPoint * 65536 + nXPoint)
    If (nIndex And &H10000) = &H10000 Then
      FileListBoxHitTest = -1   'Mauszeiger befindet sich innerhalb der 
      ' Listbox, aber nicht über einer Datei
    Else
      FileListBoxHitTest = nIndex
    End If
  End With
End Function

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.

Zitat:

Da wir einen Wert in Pixels benötigen, haben wir der Einfachheit halber den ScaleMode des UserControls auf vbPixels voreingestellt, und können nach der Zuweisung des aktuellen Fonts der ListBox an das UserControl dessen Methode TextWidth zur Ermittelung der Textbreite verwenden.

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.

Global gRect as Rect 'ist global deklariert
Private Sub Datei1_MouseMove(Index As Integer, Button As Integer, Shift As _
  Integer, X As Single, Y As Single)
  Dim DateiName As String
  Dim nIndex As Long
  Dim nTop As Long
  Dim nLeft As Long
  Dim nHeight As Long
  Dim nWidth As Long
  Dim mDesktopWindow As Long
 
  ' Mit Hilfe des ermittelten Index, wird der Dateiname an DateiName übergeben
  nIndex = FileListBoxHitTest(Datei1(glngFileList), X, Y)
  DateiName = Datei1(glngFileList).List(nIndex)
  ' PictureBox leeren, zur Aufnahme des neu ermittelten Eintrages
  PicRuler.Cls
  PicRuler.AutoRedraw = True
  Set PicRuler.Font = Datei1(glngFileList).Font
  nWidth = PicRuler.TextWidth(DateiName)
  ' Anzeige soll nur erfolgen, wenn der Eintrag(DateiName) breiter als die 
  ' FileListBox ist
  If gRect.Right - gRect.Left <= PicRuler.TextWidth(DateiName) Then
    ' Startposition für Tooltip ermitteln (bis hierher klappt alles)
    nTop = gRect.Top + (nIndex - Datei1(glngFileList).TopIndex) * gItemHeight + _
      1
    nWidth = nWidth + PicRuler.TextWidth(" ")
    ' Hier soll nur die optimale Höhe eingestellt werden
    nHeight = PicRuler.TextHeight("A") + 3
 
--> Ab hier kommen die Schwierigkeiten, wo mir der Durchblick fehlt
    ' Position auf dem Bildschirm ermitteln
    If nWidth + 1 > Screen.Width \ Screen.TwipsPerPixelX Then
      nLeft = (Screen.Width \ Screen.TwipsPerPixelX) - nWidth
    End If
    If nTop + nHeight > Screen.Height \ Screen.TwipsPerPixelY Then
      nTop = (Screen.Height \ Screen.TwipsPerPixelY) - nHeight
    End If
    Debug.Print nLeft & ", " & nTop
    If GetParent(PicRuler.hwnd) <> GetDesktopWindow() Then
      SetParent PicRuler.hwnd, GetDesktopWindow()
    End If
    nTop = nTop + gRect.Bottom
    nLeft = gRect.Left
    ' Setzen des Tooltip auf die ermittelte Position, wo der Mauszeiger steht
    SetWindowPos PicRuler.hwnd, HWND_TOPMOST, nLeft, nTop, nWidth, nHeight, _
      SWP_NOACTIVATE
    PicRuler.Visible = True
    Debug.Print frmDosShell.Left & ", " & frmDosShell.Top & ", " & nLeft & ", " _
      & nTop & ", " & nWidth & ", " & nHeight
 
Datei1(glngFileList).ToolTipText = DateiName
  Else
     Datei1(glngFileList).ToolTipText = ""
     PicRuler.Visible = False
  End If
End Sub

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.

Private Sub Datei1_MouseMove(Index As Integer, Button As Integer, Shift As _
  Integer, X As Single, Y As Single)
  Dim DateiName As String
  Dim nIndex As Long
  Dim nTop As Long
  Dim nLeft As Long
  Dim nHeight As Long
  Dim nWidth As Long
  Dim mDesktopWindow As Long
  Dim nRect As RECT
 
  ' Mit Hilfe des ermittelten Index, wird der Dateiname an DateiName übergeben
  nIndex = FileListBoxHitTest(Datei1(glngFileList), X, Y)
  DateiName = Datei1(glngFileList).List(nIndex)
  'PictureBox leeren, zur Aufnahme des neu ermittelten Eintrages
  PicRuler.Cls
  PicRuler.AutoRedraw = True
  Set PicRuler.Font = Datei1(glngFileList).Font
  PicRuler.FontSize = Datei1(glngFileList).FontSize
  nRect.Top = frmDosShell.Top \ Screen.TwipsPerPixelX
  nRect.Left = frmDosShell.Left \ Screen.TwipsPerPixelY
 
  'Anzeige soll nur erfolgen, wenn der Eintrag(DateiName) breiter als die 
  ' FileListBox ist
  If gRect.Right - PicRuler.TextWidth(DateiName) <= 0 Then
    'Startposition für Tooltip ermitteln
    nWidth = PicRuler.TextWidth(DateiName) + PicRuler.TextWidth(" ")
    nHeight = PicRuler.TextHeight("A") + 3
 
    ' Startposition = (Indexposition + Zeilenhöhe) + Hauptform.Top + 
    ' FileListBox.Top
    nTop = (nIndex * gItemHeight + 1) + nRect.Top + Datei1(glngFileList).Top + _
      41
    nLeft = nRect.Left + Datei1(glngFileList).Left + 5
    ' Position auf dem Bildschirm ermitteln
    If nWidth + 1 > lScreenWidth Then
      nLeft = lScreenWidth - nWidth
    End If
    If nTop + nHeight > lScreenHeight Then
      nTop = lScreenHeight - nHeight
    End If
    If GetParent(PicRuler.hwnd) <> GetDesktopWindow() Then
      SetParent PicRuler.hwnd, GetDesktopWindow()
    End If
    ' Setzen des Tooltip auf die ermittelte Position, wo der Mauszeiger steht
    PicRuler.Visible = True
    SetWindowPos PicRuler.hwnd, HWND_TOPMOST, nLeft, nTop, nWidth, nHeight, _
      SWP_SHOWWINDOW
    PicRuler.Print DateiName
    ' Die folgende Codezeile wäre die einfache Tooltipausgabe, ohne genaue 
    ' Positionierung
    'Datei1(glngFileList).ToolTipText = DateiName
  Else
     'Datei1(glngFileList).ToolTipText = ""
     PicRuler.Visible = False
  End If
End Sub

'Übergibt den unter dem Mauszeiger befindlichen Index
Public Function FileListBoxHitTest(FileListBox As FileListBox, ByVal X As _
  Single, ByVal Y As Single) As Long
  Dim nXPoint As Long
  Dim nYPoint As Long
  Dim nIndex As Long
 
  With Screen
    nXPoint = X / .TwipsPerPixelX
    nYPoint = Y / .TwipsPerPixelY
    lScreenWidth = .Width \ .TwipsPerPixelX
    lScreenHeight = .Height \ .TwipsPerPixelY
  End With
 
  With FileListBox
    GetClientRect .hwnd, gRect
    'Hier wird der Index(Dateiname) unter dem Mauszeiger ermittelt
    nIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, nYPoint * 65536 + nXPoint)
    'nachdem der Index ermittelt ist, wird die tatsächliche Höhe des 
    ' Listeneintrages ermittelt
    gItemHeight = SendMessage(.hwnd, LB_GETITEMHEIGHT, 0, 0)
    If (nIndex And &H10000) = &H10000 Then
      FileListBoxHitTest = -1   'Mauszeiger befindet sich innerhalb der 
      ' Listbox, aber nicht über einer Datei
      Exit Function
    Else
      FileListBoxHitTest = nIndex
    End If
  End With
End Function

'Variable für FileListBox
Global gRect As RECT
Global gItemHeight As Long
 
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const LB_ITEMFROMPOINT = &H1A9
 
Public Const SWP_SHOWWINDOW = &H40
Public Const HWND_TOPMOST = -1
 
'Die folgende API wird für den Tooltip innerhalb der FileListBox(Datei(1-3)) 
' benötigt
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