string durchsuchen, statt bestimmten Zeichensatz Bild in richTextBox einfügen

  • VB.NET

Es gibt 18 Antworten in diesem Thema. Der letzte Beitrag () ist von Slave.

    string durchsuchen, statt bestimmten Zeichensatz Bild in richTextBox einfügen

    Hallo !!!
    Ich möchte für mein Chat smileys einfügen.
    und das alles möchte ich mit einer rtb machen.
    so nun die frage wie kann ich denn string durchsuchen, und bestimmte Zeichensätze in eine bild umwandeln ich krieg das überhaubt nicht hin x.x.

    danke im voraus

    Slave

    String Funktionen, wie z.B. IndexOf zum suchen, mit Substring den Smilie rauslöschen und in den RTF Code das bild einfließen lassen(als PNG, die ByteWerte in HEX dargestellt), wie das genauere drumherum aussehen muss, kannst du dir in einer RTF Datei mit Bild angucken...
    das ganze musst du in der RTF Eigenschaft machen...
    Ich wollte auch mal ne total überflüssige Signatur:
    ---Leer---

    Snippets sind meist kurz, das hier wäre dann wohl weniger ein Snippet...
    follgende Informationen bekommst du noch von mir:

    Quellcode

    1. {\pict\pngblip\picwX\pichY
    2. HEXDATEN
    3. }

    anstatt X gibst du die Breite des Bildes in pixeln an und anstatt Y die Höhe in Pixeln...
    bei den HEXDATEN schreibst du einfach das PNG Bild(andere Bilder müssen erst konvertiert werden) d.h. die Bytes mit Header und allem drum und dran, in HEX Form rein...
    social.msdn.microsoft.com/foru…3-4672-8ccd-33718148d1e3/
    ala das hier ;)
    Ich wollte auch mal ne total überflüssige Signatur:
    ---Leer---

    Fehler 1 "As Any" wird in Declare-Anweisungen nicht unterstützt. C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 10 161 Projekt1
    Fehler 2 "SelStart" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 28 9 Projekt1
    Fehler 3 "Find" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 58 10 Projekt1
    Fehler 4 "SelStart" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 63 5 Projekt1
    Fehler 5 "Find" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 63 20 Projekt1
    Fehler 6 "SelLength" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 65 5 Projekt1
    Fehler 7 "SelStart" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 68 13 Projekt1
    Fehler 8 "SelLength" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 68 28 Projekt1
    Fehler 9 "SelText" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 70 5 Projekt1
    Fehler 10 "SelStart" ist kein Member von "System.Windows.Forms.Control". C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 81 3 Projekt1
    Fehler 11 Der Wert vom Typ "Microsoft.VisualBasic.FileAttribute" kann nicht in "System.Windows.Forms.Cursor" konvertiert werden. C:\Dokumente und Einstellungen\Slave\Desktop\Projekt1.NET1\Form1.vb 86 41 Projekt1

    VB.NET-Quellcode

    1. Public Class Form1
    3. Public Sub Create_Smileys(ByRef RTF As System.Windows.Forms.Control)
    4. Dim Picture1 As Object
    5. Dim Smileys() As String
    6. Dim SmileysFile() As String
    7. Dim Smilestring As String
    8. Dim SmileFileString As String
    9. Dim i As Short
    10. Dim Pos, Start As Integer
    11. Dim IconPath As String
    13. 'UPGRADE_WARNING: Screen Eigenschaft Screen.MousePointer hat ein neues Verhalten. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
    14. System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
    16. ' Akt. Position im RTF merken
    17. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelStart konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    18. Pos = RTF.SelStart
    20. ' Suche nach Smileys ab Stelle
    21. Start = 1
    23. ' Pfad, in dem die Bilddateien gespeichert sind
    24. IconPath = My.Application.Info.DirectoryPath & "\smileys\"
    26. ' Smileys-Tags (Zeichenfolgen) - durch
    27. ' Leerzeichen getrennt
    28. Smilestring = ":) :-) :( :-( ;) ;-) " & ":o :D :p :cool: :rolleyes: :mad:"
    30. ' Dateinamen der Bilder, durch die die Zeichenfolgen
    31. ' ersetzt werden sollen - durch Komma getrennt
    32. SmileFileString = "smiley1.gif,smiley1.gif," & "smiley2.gif,smiley2.gif," & "smiley3.gif,smiley3.gif," & "smiley4.gif,smiley5.gif," & "smiley6.gif,smiley7.gif," & "smiley8.gif,smiley9.gif"
    34. ' Strings zerlegen und in ein Array speichern (nur VB6)
    35. ' VB4/5: siehe http://www.vbarchiv.net/archiv/tipp_463.html
    36. Smileys = Split(Smilestring, " ")
    37. SmileysFile = Split(SmileFileString, ",")
    39. ' kleine Prüfung, ob gleiche Anzahl
    40. If UBound(Smileys) <> UBound(SmileysFile) Then
    41. MsgBox("Ungleiche Anzahl.")
    42. Exit Sub
    43. End If
    45. ' Nach Smileys in der RichTextBox suchen:
    46. For i = LBound(Smileys) To UBound(Smileys)
    47. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.Find konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    48. While RTF.Find(Smileys(i), Start - 1) >= 0
    49. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts Picture1.Picture konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    50. Picture1.Picture = System.Drawing.Image.FromFile(Trim(IconPath & SmileysFile(i)))
    51. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelStart konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    52. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.Find konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    53. RTF.SelStart = RTF.Find(Smileys(i), Start - 1)
    54. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelLength konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    55. RTF.SelLength = Len(Smileys(i))
    56. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelLength konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    57. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelStart konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    58. Start = RTF.SelStart + RTF.SelLength + 1
    59. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelText konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    60. RTF.SelText = ""
    61. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts Picture1.Picture konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    62. CopyPictureToRTF(RTF, Picture1.Picture)
    63. End While
    65. ' Alle Smileys eines Type gefunden. Suche von vorn
    66. Start = 1
    67. Next i
    69. ' Textmarke wieder zurücksetzen
    70. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RTF.SelStart konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    71. RTF.SelStart = Pos
    73. 'UPGRADE_ISSUE: Es kann nicht festgestellt werden, auf welche Konstante vbNormal aktualisiert werden soll. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="B3B44E51-B5F1-4FD7-AA29-CAD31B71F487"'
    74. 'UPGRADE_ISSUE: Die Screen-Eigenschaft Screen.MousePointer unterstützt keine benutzerdefinierten Mauszeiger. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="45116EAB-7060-405E-8ABE-9DBB40DC2E86"'
    75. 'UPGRADE_WARNING: Screen Eigenschaft Screen.MousePointer hat ein neues Verhalten. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
    76. System.Windows.Forms.Cursor.Current = vbNormal
    77. End Sub
    78. Private Sub CopyPictureToRTF(ByRef RTF As System.Windows.Forms.Control, ByRef Bild As System.Drawing.Image)
    79. Dim Picture1 As Object
    80. ' Diese Funktion stamt von Michael Imhof
    81. ' Siehe vb@rchiv: http://www.vbarchiv.net/archiv/tipp_56.html
    82. ' Manchmal gibt es Probleme mit dem Zurückschreiben
    83. ' der Zwischenablage, in diesem Fall kann man die Zeilen
    84. ' Clipboard.... auskommentieren
    86. Dim Buf As Object
    87. 'UPGRADE_NOTE: Text wurde aktualisiert auf Text_Renamed. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"'
    88. Dim Text_Renamed As String
    90. If My.Computer.Clipboard.ContainsText() = True Then
    91. ' Wenn in der Zwischenablage Text ist,
    92. ' wird er in einem String gespeichert
    93. Text_Renamed = My.Computer.Clipboard.GetText
    94. Else
    95. ' ansonsten in einer Variant-Variable
    96. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts Buf konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    97. Buf = My.Computer.Clipboard.GetImage()
    98. End If
    100. ' Zwischenablage löschen und Bild kopieren
    101. My.Computer.Clipboard.Clear()
    102. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts Picture1.Picture konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    103. My.Computer.Clipboard.SetImage(Picture1.Picture)
    104. System.Windows.Forms.Application.DoEvents()
    106. ' Bild per SendMessage in RTF-Box einfügen
    107. SendMessage(RTF.Handle.ToInt32, WM_PASTE, 0, 0)
    108. System.Windows.Forms.Application.DoEvents()
    109. Sleep(30) ' zur Sicherheit kurz warten
    111. ' Zwischenablage wieder löschen, da das Bild
    112. ' sonst in der Zwischenablage bleibt
    113. My.Computer.Clipboard.Clear()
    115. ' Falls vor dem Kopieren des Bildes ein Text oder
    116. ' sonstiger Inhalt in der Zwischenablage war, schreiben wir
    117. ' diesen wieder zurück in die Zwischenablage
    118. If Text_Renamed <> "" Then
    119. My.Computer.Clipboard.SetText(Text_Renamed)
    120. Else
    121. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts Buf konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    122. If Buf <> 0 Then
    123. My.Computer.Clipboard.SetImage(Buf)
    124. End If
    125. End If
    126. End Sub
    127. Private Sub Command1_Click()
    128. Dim RichTextBox1 As Object
    129. ' Alle Smiley-Tags durch Bildsymbole ersetzen
    130. 'UPGRADE_WARNING: Die Standardeigenschaft des Objekts RichTextBox1 konnte nicht aufgelöst werden. Klicken Sie hier für weitere Informationen: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    131. Create_Smileys(RichTextBox1)
    132. End Sub
    134. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    136. End Sub
    137. End Class

Facebook