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
    3. Dim PF As New PrivateFont(My.Resources.Musical)
    4. Dim LB As New ListBox
    5. Dim RB As New RichTextBox
    7. Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    8. LB.Location = New Point(10, 10) : LB.Size = New Size(100, Me.ClientSize.Height - 20)
    9. RB.Location = New Point(120, 10) : RB.Size = LB.Size
    10. Me.Controls.Add(LB)
    11. Me.Controls.Add(RB)
    13. LB.Font = PF.GetFont(14)
    14. RB.Font = PF.GetFont(14)
    15. Dim s As String
    16. For i = 120 To 250
    17. s = i.ToString + " " + Chr(i) + vbCrLf
    18. LB.Items.Add(s)
    19. RB.AppendText(s)
    20. Next
    21. End Sub
    23. Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
    24. PF.Dispose()
    25. End Sub
    26. End Class
    28. Public Class PrivateFont
    29. 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
    30. Private Declare Function RemoveFontMemResourceEx Lib "Gdi32.dll" (ByVal pbFont As IntPtr) As Boolean
    32. Dim PrivateFonts As New System.Drawing.Text.PrivateFontCollection
    33. Dim fh As IntPtr
    35. Public Sub New(source() As Byte)
    36. Dim fontMemPointer As IntPtr
    37. fontMemPointer = System.Runtime.InteropServices.Marshal.AllocCoTaskMem(source.Length)
    38. System.Runtime.InteropServices.Marshal.Copy(source, 0, fontMemPointer, source.Length)
    39. fh = AddFontMemResourceEx(fontMemPointer, source.Length, 0, 1)
    40. PrivateFonts.AddMemoryFont(fontMemPointer, source.Length)
    41. System.Runtime.InteropServices.Marshal.FreeCoTaskMem(fontMemPointer)
    42. End Sub
    44. Public Sub Dispose()
    45. RemoveFontMemResourceEx(fh)
    46. End Sub
    48. Public Function GetFont(size As Integer) As Font
    49. Return New Font(PrivateFonts.Families(0), size)
    50. End Function
    51. 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. ​
    2. Dim fnt As Font = New Font(m_PrivFontColl.Families(0), 24, FontStyle.Regular)
    4. RichTextBox1.Font = fnt
    5. RichTextBox1.Text = " "
    6. RichTextBox1.SelectionStart = 0
    7. RichTextBox1.SelectionLength = 1
    8. RichTextBox1.SelectionFont = fnt
    9. RichTextBox1.SelectedText = ""
    10. 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. ​
    2. LB.Font = PF.GetFont(14)
    3. Dim fnt As Font = PF.GetFont(14)
    5. RB.Font = fnt
    6. RB.Text = " "
    7. RB.SelectionStart = 0
    8. RB.SelectionLength = 1
    9. RB.SelectionFont = fnt
    10. RB.SelectedText = ""
    11. Dim s As String
    12. For i = 120 To 250
    13. s = i.ToString + " " + Chr(i) + vbCrLf
    14. LB.Items.Add(s)
    15. RB.AppendText(s)
    16. 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, 60 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, 56 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
    4. Public Class Form1
    6. Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    7. RichTextBox1.Text = "Das ist ein relativer langer, aber unsinniger Text."
    8. End Sub
    10. Private Sub RichTextBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles RichTextBox1.MouseDown
    11. Using fnt As Font = New Font("Courier New", 20)
    12. InsertText("ABC", fnt, Color.Blue)
    13. End Using
    14. End Sub
    16. Private Sub InsertText(ByVal txt As String, ByVal fnt As Font, ByVal col As Color)
    17. RichTextBox1.SelectionLength = 0
    18. RichTextBox1.SelectionFont = fnt
    19. RichTextBox1.SelectionColor = col
    20. RichTextBox1.SelectedText = txt
    22. ' oder nur RTF-Code ohne SelectionFont, SelectionColor und SelectedText
    23. 'RichTextBox1.SelectedRtf = "{\rtf1\ansi " & txt & "}"
    24. RichTextBox1.SelectionLength = 0
    25. End Sub
    27. 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, 194 mal angesehen
    Dateien
    Mfg -Franky-

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

Facebook
Telefonspende