Tipp-Upload: VB.NET 0117: RTF-Code manipulieren
von codester
Hinweis zum Tippvorschlag
Der Download dieses Vorschlags wurde gesperrt. Die Begründung für die Sperrung lautet: Enthält Satelitten-Dll, muss von Mitarbeiter ausführlich geprüft werden..
Über den Tipp
Dieser Tippvorschlag ist noch unbewertet.
Der Vorschlag ist in den folgenden Kategorien zu finden:
- Fenster
Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
RTF, manipulieren, OLE, Formatierung
Der Vorschlag wurde erstellt am: 29.09.2007 18:43.
Die letzte Aktualisierung erfolgte am 30.09.2007 16:48.
Beschreibung
Eine Klasse, mit deren Hilfe sich RTF-Code manipulieren lässt.
Es können einzelne Schriftattribute geändert werden, und zwar nicht, indem man wie in der RichTextBox ein komplett neues Font-Objekt erstellt, sondern durch direkte Modifizierung des eigentlichen RTF-Codes.
Außerdem kann man mit der Klasse alle (unter Umständen für die Performance hinderlichen) OLE-Objekte aus einem RTF-Text entfernen.
Die Klasse ist zwar nicht direkt von der RichTextBox abhängig, aber auf diese zugeschnitten.
Wenn z.B. in der RTB ein Text mit zwei verschiedenen Fonts markiert wurde, kann man den markierten Text Fett darstellen, ohne den gesamten Text mit ein und derselben Font formatieren zu müssen.
Wenn jemand noch einen Fehler findet, oder einen Vorschlag hat, wie man etwas besser machen kann... immer her damit!
(Es wurden noch einige Fehler verbessert)
|
Schwierigkeitsgrad
|
Verwendete API-Aufrufe: |
Download:
| Download nicht freigeschaltet. | |
' Dieser Source stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' ' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird. ' In den Zip-Dateien ist er jedoch zu finden. ' ------------ Anfang Projektgruppe RTFWorker.sln ------------ ' ----------- Anfang Projektdatei RTFWorker.vbproj ----------- ' --------------- Anfang Datei clsRTFWorker.vb --------------- Public Enum FontChangeType Size Name Bold Underline Italic End Enum Public Class RTFWorker Public Shared Function GetObjectEnd(ByVal RTF As String, ByVal ObjectBegin As Integer) As _ Integer ' Diese Funktion gibt die genaue Position innerhalb eines RTF-Textes zurück, ' an der ein OLE-Objekt, das bei 'ObjectBegin' beginnt, aufhört. Dim Z As Integer = ObjectBegin + 1 Dim KD As Integer = 1 Do Until KD = 0 Dim I As Integer = RTF.IndexOf("{", Z) Dim I2 As Integer = RTF.IndexOf("}", Z) If I < I2 And I > -1 Then KD += 1 Z = I + 1 Else KD -= 1 Z = I2 + 1 End If Loop Return Z End Function Public Shared Function RemoveObjects(ByVal RTF As String) As String ' Diese Funktion gibt einen RTF-Text zurück, aus dem alle OLE-Objekte ' entfernt wurden. If RTF Is Nothing Then Return RTF End If Do Dim Begin As Integer = RTF.IndexOf("{\obj") If Begin = -1 Then Exit Do End If RTF = RTF.Remove(Begin, GetObjectEnd(RTF, Begin) - Begin) Loop Return RTF End Function Public Shared Function EditRTF(ByVal RTF As String, ByVal ChangeType As FontChangeType, _ ByVal Value As Object) As String Select Case ChangeType Case FontChangeType.Bold If Value = True Then ' Einen Bold-Tag einzetzen RTF = RTF.Insert(RTF.IndexOf("\pard") + 5, "\b") ' Alle EndBold-Tags entfernen RTF = RTF.Replace("\b0 ", "") RTF = RTF.Replace("\b0", "") ElseIf Value = False Then ' Alle Bold-Tags entfernen ' Hinweis: Wenn es innerhalb des RTF- ' Textes eine Liste mit Schriftfarben gibt, ' darf diese beim Entfernen des Strings "\b" ' nicht mit einbezogen werden, da sie so aussehen kann: ' {\colortbl ;\red0\green0\blue255;\red128\green0\blue0;} ' Andernfalls würde sie nämlich beschädigt werden Dim SI As Integer = RTF.IndexOf("{\colortbl") If SI > -1 Then Dim ObjEnd As Integer = GetObjectEnd(RTF, SI) Dim T As String = RTF.Substring(ObjEnd, RTF.Length - ObjEnd) RTF = RTF.Substring(0, ObjEnd) & T.Replace("\b", "") Else RTF = RTF.Replace("\b", "") End If End If Case FontChangeType.Italic ' Funktioniert wie bei 'Case Bold' If Value = True Then RTF = RTF.Insert(RTF.IndexOf("\pard") + 5, "\i") RTF = RTF.Replace("\i0 ", "") RTF = RTF.Replace("\i0", "") ElseIf Value = False Then RTF = RTF.Replace("\i", "") End If Case FontChangeType.Underline ' Funktioniert wie bei 'Case Bold' If Value = True Then RTF = RTF.Insert(RTF.IndexOf("\pard") + 5, "\ul") RTF = RTF.Replace("\ulnone ", "") RTF = RTF.Replace("\ulnone", "") ElseIf Value = False Then RTF = RTF.Replace("\ul", "") End If Case FontChangeType.Name ' Die FontList suchen... Dim I As Integer = RTF.IndexOf("{\fonttbl") If I <> -1 Then ' ...sie entfernen... RTF = RTF.Remove(I, GetObjectEnd(RTF, I) - I) ' ...die neue FontList mit der neuen Font als ' einzigem Element einsetzen RTF = RTF.Insert(I, "{\fonttbl{\f0\fmodern\fcharset2 " & Value & ";}}") End If Case FontChangeType.Size ' Hinweis: ein Tag für die Schriftgröße 10 ' sieht so aus: \fs20 Dim LI As Integer = RTF.IndexOf("\fs") + 3 Dim FI As Integer = LI - 3 ' Die Schleife entfernt alle FontSize-Tags Do Dim SI As Integer = LI - 3 Dim C As Char Do C = RTF.Substring(LI, 1) LI += 1 Loop Until (Char.IsNumber(C) = False) If SI > -1 Then RTF = RTF.Remove(SI, LI - SI - 1) End If LI = RTF.IndexOf("\fs", LI) + 3 Loop Until (RTF.Contains("\fs") = False) ' An der Stelle des ersten FontSize-Tags wird ' ein anderer mit der neuen Schriftgröße einge- ' setzt. If FI > -1 Then RTF = RTF.Insert(FI, "\fs" & (Value * 2)) End If End Select Return RTF End Function End Class ' ---------------- Ende Datei clsRTFWorker.vb ---------------- ' ------------ Ende Projektdatei RTFWorker.vbproj ------------ ' ------------- Ende Projektgruppe RTFWorker.sln -------------
Diskussion
Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.