VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Einleitung

Von eMail-Programmen und News-Readern ist das automatische Zitieren der Nachrichten bekannt, auf die eine Antwort geschrieben werden soll. Im Allgemeinen werden Zitate mit ">" am Zeilenanfang gekennzeichnet und auf 60 Zeichen Breite umgebrochen.

Mit der unten vorgestellten CiteText ist genau dies möglich. Optional kann der Zeilen-Präfix (Default: ">") und die gewünschte Zeilenlänge (Default: 60) angegeben werden.

Beispiel

Wenn s folgenden Text enthält

Hallo Willi,

hier die Beschreibung des von mir gesuchten schönen Buchs...
Es handelt sich um einen Roman mit fünfhundert bis sechshundert Seiten, welche zum größten Teil auf dünnem Papier gedruckt sind. Nur der Umschlag wurde auf dickeres Papier gedruckt - wahrscheinlich um es zu schützen.

Viele Grüße
Karl Karlchen

dann gibt CiteText(s) folgendes Ergebnis zurück:

> Hallo Willi,
>
> hier die Beschreibung des von mir gesuchten schönen
> Buchs...
> Es handelt sich um einen Roman mit fünfhundert bis
> sechshundert Seiten, welche zum größten Teil auf dünnem
> Papier gedruckt sind. Nur der Umschlag wurde auf dickeres
> Papier gedruckt - wahrscheinlich um es zu schützen.
>
> Viele Grüße
> Karl Karlchen

Code / Quelltext

CiteText sucht zuerst nach einer Zeile mit einem Signatur-Trennzeichen (normalerweise "-- ", also "Minus, Minus, Leerzeichen") und schneidet ggf. die gefundene Signatur ab. Da Outlook Express Leerzeichen am Zeilenende fälschlicherweise wegoptimiert, wird dieser Sonderfall (also "--") ebenfalls berücksichtigt.

Anschließend wird Zeile für Zeile die CiteLine-Funktion aufgerufen, welche den eventuellen Zeilenumbruch durchführt und den Präfix davorhängt:

Public Function CiteText( _
    ByVal Text As String, _
    Optional ByVal Prefix As String = ">", _
    Optional ByVal MaxLen As Long = 60 _
  ) As String
  Dim i As Long
  Dim iOld As Long
  Dim Line As String
  
  'Ggf. Signatur entfernen:
  i = InStr(Text, vbNewLine & "-- " & vbNewLine)
  If i = 0 Then i = InStr(Text, vbNewLine & "--" & vbNewLine)
  If i Then Text = Left$(Text, i - 1)
  
  'Zeilenweise vorgehen:
  iOld = 1
  i = InStr(Text, vbNewLine)
  Do While i
    Line = Mid$(Text, iOld, i - iOld)
    CiteText = CiteText & _
        CiteLine(Line, Prefix, MaxLen) & vbNewLine
    iOld = i + Len(vbNewLine)
    i = InStr(iOld, Text, vbNewLine)
  Loop
  
  'Ggf. letzte Zeile bearbeiten:
  If iOld <= Len(Text) Then
    Line = Mid$(Text, iOld)
    CiteText = CiteText & CiteLine(Line, Prefix, MaxLen)
  End If
End Function

Die folgende Hilfsfunktion erhält eine (physikalische) Zeile als Input. Diese wird solange umgebrochen, bis der Rest in der gewünschten maximalen Breite vorliegt. Der Umbruch erfolgt jeweils am letzten Leerzeichen mit einer Position <= MaxLen:

Private Function CiteLine( _
    ByVal Text As String, _
    ByVal Prefix As String, _
    ByVal MaxLen As Long _
  ) As String
  Dim i As Long
  
  'Zitate nicht anfassen:
  If Left$(Text, Len(Prefix)) = Prefix Then
    CiteLine = Prefix & Text
  Else
  
    'Wiederhole, bis Text kurz genug:
    Do While Len(Text) > MaxLen
    
      'Leerzeichen suchen:
      For i = MaxLen To 1 Step -1
        If Mid$(Text, i, 1) = " " Then Exit For
      Next i
      If i = 0 Then i = MaxLen
      
      'Zeile zitieren:
      CiteLine = CiteLine & _
          Prefix & " " & RTrim$(Left$(Text, i)) & vbNewLine
      Text = LTrim$(Mid$(Text, i + 1))
    
    Loop
    CiteLine = CiteLine & Prefix & " " & Text
  
  End If
End Function