vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Controls · TextBox & RichTextBox   |   VB-Versionen: VB4, VB5, VB614.01.08
Textlänge prüfen und mit Punkten modifizieren

Ersetzt Zeichen die nicht in eine TextBox (MultiLine = False) passen, durch 3 Punkte

Autor:   VBMichiBewertung:  Views:  12.506 
www.michael-kaupp.comSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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



  • 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.
     
     
    Copyright ©2000-2024 vb@rchiv Dieter OtterAlle 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.