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
 
'Bild per Quellcode einfügen
Private Function CopyPictureToRTF(RTF As Control, Bild As Picture)
  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 Bild
  DoEvents
 
  'Bild per SendMessage in RTF-Box einfügen
  SendMessage RTF.hwnd, WM_PASTE, 0, 0
  DoEvents
  'Sleep 3000 '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
    Clipboard.SetData Buf
  End If
End Function
 
Private Sub RichTextBox1_Change()
Dim markiert, Pic1
    markiert = RichTextBox1.SelStart
    If RichTextBox1.Text = Replace(RichTextBox1.Text, ":cool:", "") = 0 Then
        RichTextBox1.Text = Replace(RichTextBox1.Text, ":cool:", "")
        CopyPictureToRTF RichTextBox1, Image1.Picture
    End If
    RichTextBox1.SelStart = markiert + 1
    Text1.Text = RichTextBox1.TextRTF
End Sub