var
  frmMain: TfrmMain;
 implementation
 {$R *.DFM}
 {$R Smiley.res}
 uses
  RichEdit;
 type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD;
  stdcall;
  TEditStream = record
  dwCookie: Longint;
  dwError: Longint;
  pfnCallback: TEditStreamCallBack;
  end;
 type
  TMyRichEdit = TRxRichEdit;
 // EditStreamInCallback callback function
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;
 // Insert Stream into RichEdit
procedure PutRTFSelection(RichEdit: TMyRichEdit; 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;
 // Load a smiley image from resource
function GetSmileyCode(ASimily: string): string;
 var
  dHandle: THandle;
  pData, pTemp: PChar;
  Size: Longint;
 begin
  pData := nil;
  dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);
  if dHandle <> 0 then
  begin
  Size := SizeofResource(hInstance, dHandle);
  dhandle := LoadResource(hInstance, dHandle);
  if dHandle <> 0 then
  try
  pData := LockResource(dHandle);
  if pData <> nil then
  try
  if pData[Size - 1] = #0 then
  begin
  Result := StrPas(pTemp);
  end
  else
  begin
  pTemp := StrAlloc(Size + 1);
  try
  StrMove(pTemp, pData, Size);
  pTemp[Size] := #0;
  Result := StrPas(pTemp);
  finally
  StrDispose(pTemp);
  end;
  end;
  finally
  UnlockResource(dHandle);
  end;
  finally
  FreeResource(dHandle);
  end;
  end;
 end;
 procedure InsertSmiley(ASmiley: string);
 var
  ms: TMemoryStream;
  s: string;
 begin
  ms := TMemoryStream.Create;
  try
  s := GetSmileyCode(ASmiley);
  if s <> '' then
  begin
  ms.Seek(0, soFromEnd);
  ms.Write(PChar(s)^, Length(s));
  ms.Position := 0;
  PutRTFSelection(frmMain.RXRichedit1, ms);
  end;
  finally
  ms.Free;
  end;
 end;
 procedure TfrmMain.SpeedButton1Click(Sender: TObject);
 begin
  InsertSmiley('Smiley1');
 end;
 procedure TfrmMain.SpeedButton2Click(Sender: TObject);
 begin
  InsertSmiley('Smiley2');
 end;
 // Replace a :-) or :-( with a corresponding smiley
procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
 var
 sCode, SmileyName: string;
  procedure RemoveText(RichEdit: TMyRichEdit);
  begin
  with RichEdit do
  begin
  SelStart := SelStart - 2;
  SelLength := 2;
  SelText := '';
  end;
  end;
 begin
 If (Key = ')') or (Key = '(') then
 begin
  sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;
  SmileyName := '';
  if sCode = ':-)' then SmileyName := 'Smiley1';
  if sCode = ':-(' then SmileyName := 'Smiley2';
  if SmileyName <> '' then
  begin
  Key := #0;
  RemoveText(RxRichEdit1);
  InsertSmiley('Smiley1');
  end;
 end;
 end;