Rubrik: Controls · TextBox & RichTextBox | VB-Versionen: VB4, VB5, VB6 | 14.01.08 |
Benötigte Controls:
eine TextBox (Text1)
ein CommandButton (Command1)
Die 3 Punkte am Ende der Textanzeige werden erst gesetzt, wenn der Text länger als "MAX_Length" (Länge des Textes, der in die angegebene TextBox passt) ist.
Damit der ursprüngliche Text nicht verloren geht, wird dieser dann als ToolTipText angezeigt.
Option Explicit
' benötigte API-Deklaration
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 Const DT_CALCRECT = &H400
Private Const DT_SINGLELINE = &H20
Private MAX_Length As Integer
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Form_Load()
' Vorgabe
Text1.Width = 2745
Text1.Text = "Das ist ein etwas längerere Text, " & vbCrLf & _
"der nicht komplett sichtbar angezeigt wird!"
' max. darstellbare Breite berechnen
' 7 abziehen (Rand der TextBox)
MAX_Length = (Text1.Width / Screen.TwipsPerPixelX) - 7
End Sub
Private Sub Command1_Click()
' Textinhalt prüfen und Anzeige ggf. modifizieren
Call SetPoints(Text1)
End Sub
' Textinhalt prüfen und ggf. mit "..." abschneiden
Private Sub SetPoints(myTextBox As TextBox)
' Falls die maximale Länge kürzer ist als die Länge der 3 Punkte
If MAX_Length <= 9 Then
Exit Sub ' dann Funktion abbrechen
' VORSICHT! KANN SICH JE NACH SCHRIFTART ÄNDERN!
End If
Dim hDcT As Long
Dim R As RECT
Dim nFlag As Long
With myTextBox
hDcT = .Parent.hdc
nFlag = DT_SINGLELINE Or DT_CALCRECT
Call DrawText(hDcT, CStr(.Text), -1, R, nFlag)
' Falls die Länge größer als die zugelassene Länge ist
If R.Right > MAX_Length Then
' ToolTipText mit komplettem Text setzen
.ToolTipText = .Text
.Text = .Text & "..."
While R.Right > MAX_Length
' Den letzten Buchstaben entfernen
.Text = Left$(.Text, Len(.Text) - 4) & "..."
' Länge neu berechnen
Call DrawText(hDcT, CStr(.Text), -1, R, nFlag)
Wend
End If
End With
End Sub