Смайлики

var
i,j: integer;

begin
for j:=0 to Memo1.Lines.Count-1 do
    i:=pos(':)', Memo1.Lines.Strings[j]; //iwem smailik :)
    if i>0 then
      begin
      //resyew zdes v i nomer simvola v j nomer stroki
      end;
end;

....
type
   TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
     cb: Longint; var pcb: Longint): DWORD;
   stdcall;

   TEditStream = record
     dwCookie: Longint;
     dwError: Longint;
     pfnCallback: TEditStreamCallBack;
   end;

....
function BitmapToRTF(pict: TBitmap): string;
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;
procedure PutRTFSelection(RichEdit: TRxRichEdit; SourceStream: TStream);

....
function BitmapToRTF(pict: TBitmap): string;
var
   bi, bb, rtf: string;
   bis, bbs: Cardinal;
   achar: ShortString;
   hexpict: string;
   I: Integer;
 begin
   GetDIBSizes(pict.Handle, bis, bbs);
   SetLength(bi, bis);
   SetLength(bb, bbs);
   GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
   rtf := '{\rtf1 {\pict\dibitmap ';
   SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
   I := 2;
   for bis := 1 to Length(bi) do
   begin
     achar := Format('%x', [Integer(bi[bis])]);
     if Length(achar) = 1 then
       achar := '0' + achar;
     hexpict[I - 1] := achar[1];
     hexpict := achar[2];
     Inc(I, 2);
   end;
   for bbs := 1 to Length(bb) do
   begin
     achar := Format('%x', [Integer(bb[bbs])]);
     if Length(achar) = 1 then
       achar := '0' + achar;
     hexpict[I - 1] := achar[1];
     hexpict := achar[2];
     Inc(I, 2);
   end;
   rtf := rtf + hexpict + ' }}';
   Result := rtf;
 end;
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;
 var
   theStream: TStream;
   dataAvail: LongInt;
 begin
   theStream := TStream(dwCookie);
   with theStream do
   begin
     dataAvail := Size - Position;
     Result := 0;
     if dataAvail <= cb then
     begin
       pcb := read(pbBuff^, dataAvail);
       if pcb <> dataAvail then
         Result := UINT(E_FAIL);
     end
     else
     begin
       pcb := read(pbBuff^, cb);
       if pcb <> cb then
         Result := UINT(E_FAIL);
     end;
   end;
 end;
procedure PutRTFSelection(RichEdit: TRxRichEdit; SourceStream: TStream);
var
 EditStream:TEditStream;
begin
 with EditStream do
  begin
   dwCookie := Longint(SourceStream);
   dwError := 0;
   pfnCallback := EditStreamInCallBack;
  end;
  RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end;
......

procedure TForm1.Button1Click(Sender: TObject);
begin
     MyBMP:=TBitMap.Create;
     MyBMP.LoadFromFile('Изображение смайлика');
     SS:=TStringStream.Create(BitmapToRTF(MyBMP));
     PutRTFSelection(RichEdit1,ss);
     MyBmp.Free;
end;

s := edit1.text;
  i:=pos(':)', s);
  while i > 0 do begin
    delete(s, i, 2);
    // вставляем картинку в позицию с индексом i
    i:=pos(':)', s);
  end;

s := edit1.text;
  i:=pos(':)', s);
  while i > 0 do begin
    delete(s, i, 2);
    // вставляем картинку в позицию с индексом i
    i:=pos(':)', s);
  end;

var
   s:string;
begin
  s:=edit1.text;
  i:=pos(':)', s);
  while i > 0 do begin
    delete(s, i, 2);
    RichEdit1.Text:=s;
    RichEdit1.SelStart:=pos(':)', s);
    Smiley(':)'); // Процедура отображения смайлика
    exit;
end;

s := edit1.text;
  RichEdit1.SelStart := Length(RichEdit1.Text); //устанавливаем курсор в конец
  while s <> '' do begin
    i:=pos(':)', s);
    if i = 0 then begin // если смайлов нет - переписываем строку целиком
      RichEdit1.SetSelTextBuf(PChar(s));
      s := '';
    end else begin // если нашли смайл - переписываем часть
      RichEdit1.SetSelTextBuf(PChar(Copy(s, 1, i - 1)); //строки перед ним,
      Smiley(':)'); //потом рисуем смайл
      delete(s, 1, i + 1); // и удаляем переписанную часть строки
    end;
  end;
  RichEdit1.SetSelTextBuf(PChar(#13)); // и наконец переводим строку

procedure TForm1.Button1Click(Sender: TObject);
var
  s:string;
  i:integer;
begin
  s := edit1.text + #$D#$A;
  RichEdit1.SelStart := Length(RichEdit1.Text); //устанавливаем курсор в конец
  while s <> '' do begin
    i:=pos(':)', s);
    if i = 0 then begin // если смайлов нет - переписываем строку целиком
      RichEdit1.SetSelTextBuf(PChar(s));
      s := '';
    end else begin // если нашли смайл - переписываем часть
      RichEdit1.SetSelTextBuf(PChar(Copy(s, 1, i - 1))); //строки перед ним,
//      Smiley(':)'); //потом рисуем смайл
      delete(s, 1, i + 1); // и удаляем переписанную часть строки
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  //процедура подстановки одной строки вместо другой
  procedure ChangeStr(var S: String; Src: String; Dest: String);
  var
    I: Integer;
  begin
    I := Pos(Src, S);
    while I > 0 do begin
      Delete(S, I, Length(Src));
      Insert(Dest, S, I);
      I := Pos(Src, S);
    end;
  end;
var
  S: String;
  I, J: Integer;
begin
  S := Edit1.Text + #$D#$A;
  ChangeStr(S, ':)', #1'00'); // #1NN - это мы условно обозначаем смайлик
  ChangeStr(S, ':(', #1'01'); // где NN - условный номер смайлика
  RichEdit1.SelStart := Length(RichEdit1.Text); //устанавливаем курсор в конец
  while S <> '' do begin
    I := Pos(#1, S);
    if I = 0 then begin // если смайлов нет - переписываем строку целиком
      RichEdit1.SetSelTextBuf(PChar(S));
      S := '';
    end else begin // если нашли смайл - переписываем часть
      RichEdit1.SetSelTextBuf(PChar(Copy(S, 1, I - 1))); //строки перед ним,
      J := StrToInt(Copy(S, I + 1, 2));  // читаем номер смайла
      case J of  // в соответствии с номером рисуем смайл
        0: {Smiley(':)')} RichEdit1.SetSelTextBuf('8)');
        1: {Smiley(':(')} RichEdit1.SetSelTextBuf('=(');
      end;
      Delete(S, 1, I + 2); // и удаляем переписанную часть строки
    end;
  end;
end;