Поместить изображение смайлика в TRxRichEdit

Delphi , Компоненты и Классы , TMemo и TRichEdit

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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;

Here is the translation of the provided code into Russian:

Введение

Код, представленный ниже, написан на языке Delphi и используется для вставки изображения смайлика в TRxRichEdit-компонент. Изображение загружается из ресурсного файла и вставляется в текущую позицию курсора.

Использование кода

1. Создайте новый проект Delphi.
2. Добавьте компонент TRxRichEdit (названный RXRichedit1) на вашу форму.
3. Перекликните кнопки быстрого доступа (SpeedButton1 и SpeedButton2) для создания их обработчиков событий клика.
4. В обработчике события клика каждой кнопки вызовите процедуру InsertSmiley с соответствующим именем смайлика ('Smiley1' или 'Smiley2').

Функции

• GetSmileyCode - функция, загружающая изображение смайлика из ресурсного файла.
• PutRTFSelection - процедура, вставляющая поток в RichEdit-компонент.
• InsertSmiley - процедура, загружающая текст как поток, вставляя его в RichEdit-компонент и затем удаляя оригинальный текст.

Обработчик событий

• RxRichEdit1KeyPress - обработчик события нажатия клавиши в RichEdit-компоненте. Он заменяет символы :-) или :-( на соответствующие изображения смайликов при вводе этих символов.

Пример использования кода

Вот пример использования кода:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms, Dialogs,
  RichEdit, RxRichedit, ExtCtrls;

type
  TfrmMain = class(TForm)
    RXRichedit1: TRxRichEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  SwissDelphiCenter;

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

  TMyRichEdit = TRxRichEdit;

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;
begin
  // Ваши код здесь
end;

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;

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;

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(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;

procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
var
  sCode, SmileyName: string;
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(SmileyName);
        end;
    end;
end;

procedure TfrmMain.RemoveText(RichEdit: TMyRichEdit);
begin
  with RichEdit do
    begin
      SelStart := SelStart - 2;
      SelLength := 2;
      SelText := '';
    end;
end;

initialization
  hInstance := HINSTANCE(Application.Instance);

end.

В статье описывается как поместить изображение смайлика в TRxRichEdit с помощью Delphi.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TMemo и TRichEdit ::