Richtextbox und PrivateFontCollection

  • VB.NET
  • .NET (FX) 4.5–4.8

Es gibt 14 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Richtextbox und PrivateFontCollection

    Hallo liebe Gemeinde,

    ich möchte in eine RichTextBox Sonderzeichen aus einem nicht installierten Font eintragen. Der Font wird aus einer Ressource geladen.
    Beim Einfügen in eine Listbox klappt alles, alle Zeichen werden richtig dargestellt. Wenn ich das gleiche mit einer Richtextbox mache werden die Zeichen Chr(0..127) richtig eingefügt.
    Bei Zeichen ab Chr(128) springt der Font auf MS Sans Serif und damit ist das Ergebnis natürlich unbrauchbar. kann mir da jemand ein bischen auf die Sprünge helfen ?
    Das ist der Quellcode für einen kurzen Test. Für eure Hilfe im Voraus besten Dank.

    VB.NET-Quellcode

    1. Public Class Form1
    2. Dim PF As New PrivateFont(My.Resources.Musical)
    3. Dim LB As New ListBox
    4. Dim RB As New RichTextBox
    5. Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    6. LB.Location = New Point(10, 10) : LB.Size = New Size(100, Me.ClientSize.Height - 20)
    7. RB.Location = New Point(120, 10) : RB.Size = LB.Size
    8. Me.Controls.Add(LB)
    9. Me.Controls.Add(RB)
    10. LB.Font = PF.GetFont(14)
    11. RB.Font = PF.GetFont(14)
    12. Dim s As String
    13. For i = 120 To 250
    14. s = i.ToString + " " + Chr(i) + vbCrLf
    15. LB.Items.Add(s)
    16. RB.AppendText(s)
    17. Next
    18. End Sub
    19. Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
    20. PF.Dispose()
    21. End Sub
    22. End Class
    23. Public Class PrivateFont
    24. Private Declare Function AddFontMemResourceEx Lib "Gdi32.dll" (ByVal pbFont As IntPtr, ByVal cbFont As Integer, ByVal pdv As Integer, ByRef pcFonts As Integer) As IntPtr
    25. Private Declare Function RemoveFontMemResourceEx Lib "Gdi32.dll" (ByVal pbFont As IntPtr) As Boolean
    26. Dim PrivateFonts As New System.Drawing.Text.PrivateFontCollection
    27. Dim fh As IntPtr
    28. Public Sub New(source() As Byte)
    29. Dim fontMemPointer As IntPtr
    30. fontMemPointer = System.Runtime.InteropServices.Marshal.AllocCoTaskMem(source.Length)
    31. System.Runtime.InteropServices.Marshal.Copy(source, 0, fontMemPointer, source.Length)
    32. fh = AddFontMemResourceEx(fontMemPointer, source.Length, 0, 1)
    33. PrivateFonts.AddMemoryFont(fontMemPointer, source.Length)
    34. System.Runtime.InteropServices.Marshal.FreeCoTaskMem(fontMemPointer)
    35. End Sub
    36. Public Sub Dispose()
    37. RemoveFontMemResourceEx(fh)
    38. End Sub
    39. Public Function GetFont(size As Integer) As Font
    40. Return New Font(PrivateFonts.Families(0), size)
    41. End Function
    42. End Class
    @mig
    Ich kann Dein Problem mit eigenen TestCode nachvollziehen. Wobei RichTextBox.Font = Font aus der PrivateFontCollection so nicht von Anfang an funktioniert. Was funktioniert ist wenn Du ein Zeichen in die RTB schreibst, dieses selektierst und per RichTextBox1.SelectionFont den Font aus der PrivateFontCollection zuweist. Danach kannst dieses eine Zeichen löschen.
    Im groben in etwa so:

    VB.NET-Quellcode

    1. Dim fnt As Font = New Font(m_PrivFontColl.Families(0), 24, FontStyle.Regular)
    2. RichTextBox1.Font = fnt
    3. RichTextBox1.Text = " "
    4. RichTextBox1.SelectionStart = 0
    5. RichTextBox1.SelectionLength = 1
    6. RichTextBox1.SelectionFont = fnt
    7. RichTextBox1.SelectedText = ""
    8. RichTextBox1.AppendText("neuer Text") ' <- ab jetzt funktioniert der Font
    Mfg -Franky-
    Danke für Deine Antwort. Habe Deinen Code probiert, aber es ändert sich nichts. Die Zeichen ab Chr(128) haben als Font MS Sans Serif. Das gleiche passiert wenn Zeichen anstelle von AppendText mit SelectedText eingefügt werden.

    VB.NET-Quellcode

    1. LB.Font = PF.GetFont(14)
    2. Dim fnt As Font = PF.GetFont(14)
    3. RB.Font = fnt
    4. RB.Text = " "
    5. RB.SelectionStart = 0
    6. RB.SelectionLength = 1
    7. RB.SelectionFont = fnt
    8. RB.SelectedText = ""
    9. Dim s As String
    10. For i = 120 To 250
    11. s = i.ToString + " " + Chr(i) + vbCrLf
    12. LB.Items.Add(s)
    13. RB.AppendText(s)
    14. Next
    Wenn ich die Schriftart installiere funktionierts, das möchte ich aber nicht. Am ende sollen die Sonderzeichen per Mausklick in die RichTextbox eingefügt werden (also mit Selectedtext). Und ich brauche einige Zeichen >127. Als Anhang der Font der Begierde.
    Dateien
    • Musical.zip

      (28,59 kB, 85 mal heruntergeladen, zuletzt: )
    @mig
    Hmm. Also wenn Du RB.AppendText(i.ToString & " " & ChrW(i)) machst, sollten die zeichen korrekt dargestellt werden. Mit zusätzlichen Zeilenumbruch (vbCrLf, vbNewLine, und was es sonst noch so gibt), ist das ganze aber wieder kaputt. Probiere daher mal nur für die RTB

    VB.NET-Quellcode

    1. RB.AppendText(i.ToString & " " & ChrW(i) & ChrW(8232))


    @Haudruferzappeltnoch
    Meine Idee wäre folgende: Die Message (WM_PASTE?), oder die entsprechende Tastenkombination, für das einfügen des Textes in die RTB abfangen und verwerfen. Selbst den RTF-Text aus der Zwischenablage holen, die Farben im RTF-String entsprechend ersetzen/austauschen und dann den bearbeiteten RTF-String der RTB übergeben. So bleiben zumindest die Schriftarten und Formatierungen wie Kursiv, Fett usw erhalten.
    Mfg -Franky-

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „-Franky-“ ()

    Hallo -Franky-

    das war der richtige Tip. Habe mal das Testprogramm angehängt. Es gibt zwar jetzt auch wieder Besonderheiten wie beim 2. Eintrag der Listbox (in ASCII geschweifte Klammer)- der wird im RTF anders behandelt ist aber lösbar. Lieber wäre mir zwar die Lösung mit Insert_SelectedText aber wenns mit Insert_Clipboard funktioniert - was solls. Dein Vorschlag mit ChrW(i) hat nicht geklappt.

    mfg mig
    Dateien
    • Richtextbox.zip

      (130,8 kB, 85 mal heruntergeladen, zuletzt: )
    @mig
    Den Weg über das Clipboard kannst Dir sparen. Mal so ganz grob als Anregung:

    VB.NET-Quellcode

    1. Option Strict On
    2. Option Explicit On
    3. Public Class Form1
    4. Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    5. RichTextBox1.Text = "Das ist ein relativer langer, aber unsinniger Text."
    6. End Sub
    7. Private Sub RichTextBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles RichTextBox1.MouseDown
    8. Using fnt As Font = New Font("Courier New", 20)
    9. InsertText("ABC", fnt, Color.Blue)
    10. End Using
    11. End Sub
    12. Private Sub InsertText(ByVal txt As String, ByVal fnt As Font, ByVal col As Color)
    13. RichTextBox1.SelectionLength = 0
    14. RichTextBox1.SelectionFont = fnt
    15. RichTextBox1.SelectionColor = col
    16. RichTextBox1.SelectedText = txt
    17. ' oder nur RTF-Code ohne SelectionFont, SelectionColor und SelectedText
    18. 'RichTextBox1.SelectedRtf = "{\rtf1\ansi " & txt & "}"
    19. RichTextBox1.SelectionLength = 0
    20. End Sub
    21. End Class
    Mfg -Franky-

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „-Franky-“ ()

    Hallo -Franky-

    so wollte ich es ja machen aber da ist der Hund begraben bei Zeichen>127 ändert die Richtextbox den Font auf MS Sans Serif. Warum weiß wohl bloß MS.
    Hab noch ein bischen rumgespielt. So gehts !!!
    Erst Zeichen einfügen, dann markieren und den Font ändern

    VB.NET-Quellcode

    1. Private Sub Insert_SelectedText()
    2. With RichTextBox1
    3. .SelectionLength = 0
    4. .SelectionColor = Color.Blue
    5. .SelectedText = Label1.Text
    6. .SelectionStart -= 1
    7. .SelectionLength = 1
    8. .SelectionFont = PF.GetFont(14)
    9. End With
    10. End Sub


    Danke für Deine Anregungen

    @mig
    Hi. Hab mal Deine Schrift Musical.ttf mit meinen VB6-Codes (eins mit GDI32 und eins mit GDI+) für PrivateFontsCollection und einer RichTextBox getestet. Gleiches Ergebnis wie in .NET. Andere Schriftarten, aus einer Ressource geladen, funktionieren problemlos darüber. Hmm, hab mir gedacht, irgendetwas ist dann an Deiner Musical.ttf anders als bei anderen TTF-Dateien. Hab dann Deine Musical.ttf mal mit FontForge geladen. So wie es ausschaut ist Deine Schrift eigentlich für einen Mac gedacht. Unter Windows könnte es unter Umständen mit dieser Musical.ttf zu Problemen kommen. Im Bild mal der Vergleich mit Deiner Schrift mit einer anderen TTF-Schrift in FontForge. Beide Schriftarten lade ich aus einer Ressource in eine PrivateFontsCollection. Deine Schrift funktioniert nicht so wie man es erwartet, die andere dagegen schon.

    Edit: Ich war mal so frei und habe Deine Mac-TTF in eine Windows-TTF konvertiert. Damit sollten entsprechende Probleme mit der RichTextBox erledigt sein.
    Bilder
    • ttf.png

      2,08 kB, 272×63, 223 mal angesehen
    Dateien
    Mfg -Franky-

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „-Franky-“ ()