Mehrzeiliges ToolTip

DrMueller

Erfahrenes Mitglied
Hallo Leute,

wie ihr evtl. wisst, ist es praktisch unmöglich, mit dem Standard ToolTip-Property was anderes als reinen Text auszugeben. Soweit kein Problem, nur benötige ich eines, welches Adresse inkl. Strasse etc. ausgibt, und da benötige ich Zeilenumbrüche.

Laut Onkel Google ist es tatsächlich nicht so leicht möglich, ToolTips mit Zeilenumbrüchen darzustellen. Leider sind alle gefundene Lösungen entweder unbefriedigend oder passen nicht.

Kennt jemand einen Weg, wie man wirklich nur das ToolTip simulieren kann?


Vielen Dank im Voraus für alle Antworten.


Müller Matthias
 
Hab grad kein VB sondern nur MS Access zur Hand. Dort geht es mit vbcrlf
Code:
Me.MyControl.ControlTipText = "Hallo" & vbCrLf & "Welt"
 
Kann jetzt keinen Screenshot machen, aber mit
Code:
Command1.ToolTipText = "bla" & vbCrLf & "bla"
oder ähnlichem geht es definitiv nicht.
 
Da es scheinbar so schwierig ist das zu lösen, wäre es viellicht ganz gut wenn du sagst wie deine Lösung jetzt aussieht.

Vielleicht hat ja mal jemand anderes auch das Problem!
 
Naja die Lösung ist neben net schön, man muss auf den Datensatz klicken, damit's erscheint.
Ist glaube ich original aus vbArchiv, wurde aber eben bei uns bereits in einer DLL verarbeitet.

Hier der komplette Code:

Code:
Option Explicit

Private Declare Function GetDesktopWindow Lib "user32" () As Long

' Konstanten zum Erzeugen des ToolTip-Fensters
Private Const WS_POPUP = &H80000000
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_NOPREFIX = &H2
Private Const TTS_BALLOON = &H40
Private Const CW_USEDEFAULT = &H80000000

' Konstanten zum Ändern/Erstellen der ToolTips
Private Const WM_USER = &H400
Private Const TTM_SETDELAYTIME = WM_USER + 3
Private Const TTM_ADDTOOL = WM_USER + 4
Private Const TTM_SETTIPBKCOLOR = WM_USER + 19
Private Const TTM_SETTIPTEXTCOLOR = WM_USER + 20
Private Const TTM_SETMAXTIPWIDTH = WM_USER + 24
Private Const TTM_SETTITLE = WM_USER + 32

' Konstanten zum Setzen der Zeiten, nachdem der ToolTip
' erscheint bzw. wieder verschwindet
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3

' Konstanten, welche über das Aussehen und das Verhalten
' des ToolTip-Fensters bestimmen
Private Const TTF_IDISHWND = &H1
Private Const TTF_CENTERTIP = &H2
Private Const TTF_SUBCLASS = &H10

' Konstanten zum Setzen der Schriftart des ToolTips
Private Const WM_SETFONT = &H30
Private Const LOGPIXELSY = 90

' Verschiedene Typdeklarationen für die API-Funktionen
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type TOOLINFO
  cbSize As Long
  uFlags As Long
  HWND As Long
  uId As Long
  cRect As RECT
  hinst As Long
  lpszText As String
End Type

' API-Funktionsdeklarationen
Private Declare Function CreateWindowEx Lib "user32.dll" _
  Alias "CreateWindowExA" ( _
  ByVal lExStyle As Long, _
  ByVal strClassName As String, _
  ByVal strWindowName As String, _
  ByVal lStyle As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal lWidth As Long, _
  ByVal lHeight As Long, _
  ByVal hWndParent As Long, _
  ByVal hMenu As Long, _
  ByVal hInstance As Long, _
  lParam As Any) As Long

Private Declare Function DestroyWindow Lib "user32.dll" ( _
  ByVal HWND As Long) As Long

Private Declare Function GetClientRect Lib "user32.dll" ( _
  ByVal HWND As Long, _
  lpRect As RECT) As Long

Private Declare Function SendMessage Lib "user32.dll" _
  Alias "SendMessageA" ( _
  ByVal HWND As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long

Private Declare Function SendMessageLong Lib "user32.dll" _
  Alias "SendMessageA" ( _
  ByVal HWND As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long

Private Declare Function SendMessageStr Lib "user32.dll" _
  Alias "SendMessageA" ( _
  ByVal HWND As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As String) As Long

Private Declare Function GetDC Lib "user32.dll" ( _
  ByVal HWND As Long) As Long

Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Declare Function CreateFont Lib "gdi32.dll" _
  Alias "CreateFontA" ( _
  ByVal lHeight As Long, _
  ByVal lWidth As Long, _
  ByVal lEscapement As Long, _
  ByVal lOrientation As Long, _
  ByVal lBold As Long, _
  ByVal lItalic As Long, _
  ByVal lUnderline As Long, _
  ByVal lStrikethrough As Long, _
  ByVal lCharset As Long, _
  ByVal lOutputPrecision As Long, _
  ByVal lClipPrecision As Long, _
  ByVal lQuality As Long, _
  ByVal lPitchAndFamily As Long, _
  ByVal strFontName As String) As Long

Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
  ByVal hDC As Long, _
  ByVal nIndex As Long) As Long

Private Declare Function MulDiv Lib "kernel32.dll" ( _
  ByVal lNumber As Long, _
  ByVal lNumerator As Long, _
  ByVal lDenominator As Long) As Long

' Membervariablen der Klasse
' Window-Handle des erzeugten ToolTip-Fensters
Private m_hWnd As Long

' Max. erlaubte Breite des ToolTip-Fensters
Private m_lMaxWidth As Long

' Aufzählung für das Icon im ToolTip
Public Enum enumIcon
  NoIcon = 0
  InfoIcon = 1
  WarningIcon = 2
  ErrorIcon = 3
End Enum

' Initialisierung
Private Sub Class_Initialize()
  InitCommonControls
  m_lMaxWidth = 300
End Sub

' Beenden
Private Sub Class_Terminate()
  If m_hWnd <> 0 Then DestroyWindow m_hWnd
End Sub

' Setzen der maximalen Breite des ToolTip-Fensters in Pixel
Public Property Let MaxWidth(ByVal lMaxWidth As Long)
  m_lMaxWidth = lMaxWidth
  SendMessageLong m_hWnd, TTM_SETMAXTIPWIDTH, 0, _
    m_lMaxWidth
End Property

' Setzen der Zeit in Millisekunden, wie lange der
' ToolTip angezeigt werden soll.
Public Property Let VisibleTime(ByVal lTime As Long)
  If lTime > 32767 Then lTime = 32767
  If lTime < 0 Then lTime = 0
    
  SendMessageLong m_hWnd, TTM_SETDELAYTIME, _
    TTDT_AUTOPOP, lTime
End Property

' Setzen der Zeit in Millisekunden, die vergeht, bis
' der ToolTip angezeigt werden soll.
Public Property Let DelayTime(ByVal lTime As Long)
  If lTime > 32767 Then lTime = 32767
  If lTime < 0 Then lTime = 0
    
  SendMessageLong m_hWnd, TTM_SETDELAYTIME, _
    TTDT_INITIAL, lTime
End Property

' Setzen der Text- und Rahmenfarbe für das ToolTip-
' Fenster.
Public Property Let ToolTipTextColor(ByVal lColor As Long)
  SendMessageLong m_hWnd, TTM_SETTIPTEXTCOLOR, lColor, 0
End Property

' Hintergrundfarbe für das ToolTip-Fenster
Public Property Let ToolTipBackColor(ByVal lColor As Long)
  SendMessageLong m_hWnd, TTM_SETTIPBKCOLOR, lColor, 0
End Property

' Schriftart für den Text im ToolTip festlegen
' Erwartet wird ein Standard Font-Objekt
Public Property Set Font(ByVal objFont As StdFont)
  Dim hFont As Long
  Dim lHeight As Long
  Dim lItalic As Long
  Dim lBold As Long
  Dim lUnderline As Long
  Dim lStrikethrough As Long
  Dim lDefaultLocaleID As Long
  Dim lRet As Long
  Dim strCodePage As String * 6
  Dim lCodePage As Long
  
  If objFont Is Nothing Then Exit Property
  
  ' Um dem ToolTip-Fenster eine andere Schriftart
  ' unterzujubeln, gibt es leider keine Eigenschaft,
  ' die es ermöglicht, einfach so einen Schriftnamen
  ' oder eine Schriftgröße an das Window-Handle zu
  ' senden. Wir müssen dazu mit der API-Funktion
  ' CreateFont einen Font-Handle erzeugen und diesen
  ' mit Hilfe der Nachricht WM_SETFONT an das ToolTip-
  ' Fenster senden.

  ' Um mit der API-Funktion CreateFont einen korrekten
  ' Handle für einen Font zu erzeugen, muss die Größe
  ' des Fonts in Pixel auf dem Ausgabemedium
  ' umgerechnet werden. Dazu wird die untenstehende
  ' Formel verwendet, welche in der MSDN mehrfach zu
  ' finden ist.
  
  lHeight = -MulDiv(objFont.Size, _
    GetDeviceCaps(GetDC(m_hWnd), LOGPIXELSY), 72)
  
  ' Für die Funktion CreateFont müssen die
  ' Schriftattribute "Fett", "Kursiv", "Unterstrichen"
  ' und "Durchgestrichen" noch umdefiniert werden.
  ' Dabei kommt dem Attribut "Fett" eine besondere
  ' Bedeutung zu, da man hier sehr viele verschiedene
  ' Werte zwischen 100 und 900 angeben kann. Dabei
  ' entspricht ein Wert von 400 ungefähr dem
  ' Normaldruck und ein Wert von 700 entspricht etwa
  ' dem Fettdruck.
  
  lItalic = IIf(objFont.Italic, 1&, 0&)
  lBold = IIf(objFont.Bold, 700&, 400&)
  lUnderline = IIf(objFont.Underline, 1&, 0&)
  lStrikethrough = IIf(objFont.Strikethrough, 1&, 0&)

  ' Nun kann endlich die erforderliche Schrift mit der
  ' Funktion CreateFont erzeugt werden und mit
  ' SendMessageLong an das ToolTip-Fenster geschickt
  ' werden.
  
  hFont = CreateFont(lHeight, 0&, 0&, 0&, lBold, _
    lItalic, lUnderline, lStrikethrough, _
    0&, 0&, 0&, 0&, 0&, objFont.Name)

  lRet = SendMessageLong(m_hWnd, WM_SETFONT, hFont, 1&)
End Property


' Erzeugt das ToolTip-Fenster
Public Sub Create(ByVal hWndParent As Long, _
  Optional ByVal bAlwaysTip As Boolean = True, _
  Optional ByVal bBalloonTip As Boolean = True)

  Dim nFlags As Long
  Dim lPar As Long
  lPar = GetDesktopWindow()

  ' Wir möchten kein normales Fenster :-)
  nFlags = WS_POPUP Or TTS_NOPREFIX
  
  ' Falls der ToolTip auch bei deaktiviertem
  ' Control erscheinen soll...
  If bAlwaysTip Then nFlags = nFlags Or TTS_ALWAYSTIP
  
  ' Falls ein "moderner" Balloon-ToolTip erwünscht...
  If bBalloonTip Then nFlags = nFlags Or TTS_BALLOON

  ' Window-Handle erstellen
'  m_hWnd = CreateWindowEx(0, "tooltips_class32", 0, _
    nFlags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
    CW_USEDEFAULT, hWndParent, 0, App.hInstance, 0)

  m_hWnd = CreateWindowEx(0, "tooltips_class32", 0, _
    nFlags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
    CW_USEDEFAULT, lPar, 0, App.hInstance, 0)

  ' maximale Fensterbreite festlegen
  SendMessageLong m_hWnd, TTM_SETMAXTIPWIDTH, 0, m_lMaxWidth
  
End Sub

' ToolTip zerstören
Public Sub Destroy()
  DestroyWindow m_hWnd
End Sub

Public Sub AddControl(ByVal objControl As Object, _
  ByVal strCaption As String, _
  Optional ByVal bCenterToolTip As Boolean = False)

  Dim udtToolInfo As TOOLINFO
    
  With udtToolInfo
    GetClientRect objControl.HWND, .cRect
    .HWND = objControl.HWND
    .uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    If bCenterToolTip Then
      .uFlags = .uFlags Or TTF_CENTERTIP
    End If
    .uId = objControl.HWND
    .lpszText = strCaption
    .cbSize = Len(udtToolInfo)
  End With
    
  SendMessage m_hWnd, TTM_ADDTOOL, 0, udtToolInfo
End Sub

' ToolTip Icon und Titeltext festlegen
Public Sub SetToolTipTitle(ByVal strTitle As String, _
  ByVal iTitleIcon As enumIcon)
  
  SendMessageStr m_hWnd, TTM_SETTITLE, _
    iTitleIcon, strTitle
End Sub
 
Zurück