TRichEdit

Code:

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;