vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Controls · TextBox & RichTextBox   |   VB-Versionen: VB4, VB5, VB627.05.04
Smileys in der Richtextbox

Wie man Text-Smilies in einer RichTextBox durch entsprechende Smiley-Icons ersetzt, das erfahren Sie hier.

Autor:   Hendrik StorckBewertung:     [ Jetzt bewerten ]Views:  18.036 
www.hs-software.infoSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Mit diesem Sourcecode ist es möglich, "Text-Smilies" wie , , usw. durch entsprechende Bildchen zu ersetzen.

Hinweis: Der Sourcecode verwendet den Tipp von Michael Imhof Bilder in der RTF-Textbox

Platzieren Sie auf einer Form eine Richtextbox, einen Button sowie ein unsichtbares Picture-Objekt und fügen folgenden Code in die Form ein:

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Sub Sleep Lib "kernel32" ( _
  ByVal dwMilliseconds As Long)
 
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private Const WM_PASTE = &H302
Public Sub Create_Smileys(RTF As Control)
  Dim Smileys() As String
  Dim SmileysFile() As String
  Dim Smilestring As String
  Dim SmileFileString As String
  Dim i As Integer
  Dim Pos As Long, Start As Long
  Dim IconPath As String
 
  Screen.MousePointer = vbHourglass
 
  ' Akt. Position im RTF merken
  Pos = RTF.SelStart
 
  ' Suche nach Smileys ab Stelle
  Start = 1
 
  ' Pfad, in dem die Bilddateien gespeichert sind
  IconPath = App.Path & "\smileys\"
 
  ' Smileys-Tags (Zeichenfolgen) - durch
  ' Leerzeichen getrennt
  Smilestring = ":) :-) :( :-( ;) ;-) " & _
    ":o :D :p :cool: :rolleyes: :mad:"
 
  ' Dateinamen der Bilder, durch die die Zeichenfolgen
  ' ersetzt werden sollen - durch Komma getrennt
  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"
 
  ' Strings zerlegen und in ein Array speichern (nur VB6)
  ' VB4/5: siehe http://www.vbarchiv.net/archiv/tipp_463.html
  Smileys = Split(Smilestring, " ")
  SmileysFile = Split(SmileFileString, ",")
 
   ' kleine Prüfung, ob gleiche Anzahl
  If UBound(Smileys) <> UBound(SmileysFile) Then
    MsgBox "Ungleiche Anzahl."
    Exit Sub
  End If
 
  ' Nach Smileys in der RichTextBox suchen:
  For i = LBound(Smileys) To UBound(Smileys)
    While RTF.Find(Smileys(i), Start - 1) >= 0
      Picture1.Picture = LoadPicture(Trim$(IconPath & SmileysFile(i)))
      RTF.SelStart = RTF.Find(Smileys(i), Start - 1)
      RTF.SelLength = Len(Smileys(i))
      Start = RTF.SelStart + RTF.SelLength + 1
      RTF.SelText = ""
      CopyPictureToRTF RTF, Picture1.Picture
    Wend
 
    ' Alle Smileys eines Type gefunden. Suche von vorn
    Start = 1
  Next i
 
  ' Textmarke wieder zurücksetzen
  RTF.SelStart = Pos
 
  Screen.MousePointer = vbNormal
End Sub
Private Sub CopyPictureToRTF(RTF As Control, Bild As Picture)
  ' Diese Funktion stamt von Michael Imhof
  ' Siehe vb@rchiv: http://www.vbarchiv.net/archiv/tipp_56.html
  ' Manchmal gibt es Probleme mit dem Zurückschreiben
  ' der Zwischenablage, in diesem Fall kann man die Zeilen
  ' Clipboard.... auskommentieren
 
  Dim Buf As Variant
  Dim Text As String
 
  If Clipboard.GetFormat(vbCFText) = True Then
    ' Wenn in der Zwischenablage Text ist,
    ' wird er in einem String gespeichert
    Text = Clipboard.GetText
  Else
    ' ansonsten in einer Variant-Variable
    Buf = Clipboard.GetData
  End If
 
  ' Zwischenablage löschen und Bild kopieren
  Clipboard.Clear
  Clipboard.SetData Picture1.Picture
  DoEvents
 
  ' Bild per SendMessage in RTF-Box einfügen
  SendMessage RTF.hwnd, WM_PASTE, 0, 0
  DoEvents
  Sleep 30 ' zur Sicherheit kurz warten
 
  ' Zwischenablage wieder löschen, da das Bild
  ' sonst in der Zwischenablage bleibt
  Clipboard.Clear
 
  ' Falls vor dem Kopieren des Bildes ein Text oder
  ' sonstiger Inhalt in der Zwischenablage war, schreiben wir
  ' diesen wieder zurück in die Zwischenablage
  If Text <> "" Then
    Clipboard.SetText Text
  Else
    If Buf <> 0 Then
      Clipboard.SetData Buf
    End If
  End If
End Sub
Private Sub Command1_Click()
  ' Alle Smiley-Tags durch Bildsymbole ersetzen
  Create_Smileys RichTextBox1
End Sub

Damit das Beispiel funktioniert, müssen Sie im Projektordner einen Unterordner smileys erstellen und die entsprechenden Smiley-Dateien dort ablegen:
 smileys.zip (7 KB)

Übersicht der im Tipp unterstützten Smiley-Tags

oder
oder
oder ;)

 

Dieser Tipp wurde bereits 18.036 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel