Benötigte Controls: 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. 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 Dieser Tipp wurde bereits 12.503 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
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. |