RichEdit

开发平台：
Delphi

Unit1.pas：源码内容
							unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, RVStyle, RVScroll, RichView, RVEdit, ComCtrls, StdCtrls;
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    rve1: TRichViewEdit;
    RVStyle1: TRVStyle;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    rv2: TRichView;
    rv3: TRichView;
    rve4: TRichViewEdit;
    Button3: TButton;
    Label1: TLabel;
    TabSheet4: TTabSheet;
    rv5: TRichView;
    rve6: TRichViewEdit;
    Label2: TLabel;
    Button4: TButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure rve6KeyPress(Sender: TObject; var Key: Char);
    procedure rve6KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure rv5RVFImageListNeeded(Sender: TCustomRichView;
      ImageListTag: Integer; var il: TCustomImageList);
  private
    { Private declarations }
    procedure AddWithIcons(rv: TCustomRichView; s: String; StyleNo: Integer; var ParaNo: Integer);
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  rve1.Clear;
  rve1.AddNL('John: ', 3, 0);
  rve1.AddNL('Funny, very funny :)', 0, -1);
  rve1.AddNL('Rob: ', 3, 0);
  rve1.AddNL('I do not think so :(...', 0, -1);
  rve1.Format;
  rve4.Clear;
  rve4.AddNL('La la la:):):):)', 1, 0);
  rve4.AddNL('La la la:):):):)', 2, -1);
  rve4.AddNL('La la la:):):):)', 0, -1);
  rve4.Format;
end;
{------------------------------------------------------------------------------}
// Using Search feature of RichViewEdit to insert emotion icons
procedure TForm1.Button1Click(Sender: TObject);
  procedure SearchAndInsertIcon(const Code: String; ImageIndex: Integer);
  begin
    rve1.SetSelectionBounds(0, rve1.GetOffsBeforeItem(0), 0, rve1.GetOffsBeforeItem(0));
    while rve1.SearchText(Code, [rvseoDown]) do
      rve1.InsertBullet(ImageIndex, ImageList1);
  end;
begin
  LockWindowUpdate(rve1.Handle);
  try
    SearchAndInsertIcon(':)', 0);
    SearchAndInsertIcon(':|', 1);
    SearchAndInsertIcon(':(', 2);
  finally
    LockWindowUpdate(0);
  end;
end;
{------------------------------------------------------------------------------}
function GetImageIndex(mouth: Char): Integer;
begin
  case mouth of
    ')': Result := 0;
    '|': Result := 1;
    else Result := 2;
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.AddWithIcons(rv: TCustomRichView; s: String; StyleNo: Integer; var ParaNo: Integer);
var s2: String;
    p: Integer;
begin
  s2 := '';
  while s<>'' do
  begin
    p := Pos(':', s); // searching for "eyes"
    if p=0 then
    begin
      // not found
      rv.AddNL(s2+s, StyleNo, ParaNo);
      ParaNo := -1;
      exit;
    end;
    // is it really "eyes"?
    if (Length(s)>p) and (s[p+1] in [')','|','(']) then
    begin
      // a smile is found
      s2 := s2+Copy(s, 1, p-1);
      if s2<>'' then
      begin
        rv.AddNL(s2, StyleNo, ParaNo);
        s2 := '';
        ParaNo := -1;
      end;
      rv.AddBulletEx( '', GetImageIndex(s[p+1]), ImageList1, ParaNo);
      ParaNo := -1;
      s := Copy(s, p+2, Length(s));
    end
    else
    begin
      // this is not a smile
      s2 := Copy(s, 1, p);
      s := Copy(s, p+1, Length(s));
    end;
  end;
  
  if s2<>'' then
    begin
      rv.AddNL(s2, StyleNo, ParaNo);
      s2 := '';
      ParaNo := -1;
    end;
end;
{------------------------------------------------------------------------------}
// From TEdit
procedure TForm1.Button2Click(Sender: TObject);
var ParaNo: Integer;
begin
  if Edit1.Text<>'' then
  begin
    rv2.AddNL('Me: ',3,0);
    ParaNo := -1; // adding to the same line
    AddWithIcons(rv2, Edit1.Text, 0, ParaNo);
    rv2.FormatTail;
    Edit1.Text := '';
  end
  else
    Beep;
end;
{------------------------------------------------------------------------------}
// From TRichViewEdit with emoticons detection
procedure TForm1.Button3Click(Sender: TObject);
var i: Integer;
    ParaNo: Integer;
begin
  // this example has the following limitations:
  // - non-text will be ignored
  // - assumes that styles of rv3 and rve4 are the same
  ParaNo := 0;
  for i := 0 to rve4.ItemCount-1 do
  begin
    if rve4.IsFromNewLine(i) then
      ParaNo := rve4.GetItemPara(i);
    if rve4.GetItemStyle(i)>=0 then
      AddWithIcons(rv3, rve4.GetItemText(i), rve4.GetItemStyle(i), ParaNo);
  end;
  rv3.FormatTail;
  rve4.SetFocus;
end;
{------------------------------------------------------------------------------}
// From TRichViewEdit as is
procedure TForm1.Button4Click(Sender: TObject);
var Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  rve6.SaveRVFToStream(Stream, False);
  Stream.Position := 0;
  rv5.InsertRVFFromStream(Stream, rv5.ItemCount);
  Stream.Free;
  rv5.FormatTail;
  rve6.SetFocus;  
end;
{------------------------------------------------------------------------------}
// Emoticons autodetection on typing
procedure TForm1.rve6KeyPress(Sender: TObject; var Key: Char);
var
  rve: TCustomRichViewEdit;
  ItemNo, Offs: Integer;
  s: String;
  function GetImageIndex(mouth: Char): Integer;
  begin
    case mouth of
      ')': Result := 0;
      '|': Result := 1;
      else Result := 2;
    end;
  end;
begin
  if not (Key in [')', '(', '|']) then
    exit;
  rve := (Sender as TCustomRichViewEdit).TopLevelEditor;
  ItemNo := rve.CurItemNo;
  if rve.GetItemStyle(ItemNo)<0 then
    exit;
  Offs := rve.OffsetInCurItem;
  s := rve.GetItemTextA(ItemNo);
  if (s='') or (Offs=1) then
    exit;
  if s[Offs-1]=':' then begin
    rve.SetSelectionBounds(ItemNo, Offs-1, ItemNo, Offs);
    rve.InsertBullet(GetImageIndex(Key), ImageList1);
    Key := #0;
  end;
end;
{------------------------------------------------------------------------------}
// BACKSPACE disassembles emoticon
procedure TForm1.rve6KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  rve: TCustomRichViewEdit;
  ItemNo, Offs: Integer;
  function GetBulletImageIndex: Integer;
  var s: String;
      tag: Integer;
      il: TCustomImageList;
  begin
    rve.GetBulletInfo(ItemNo, s, Result, il, tag);
  end;
  function GetSmile(ImageIndex: Integer): String;
  begin
    case ImageIndex of
      0: Result := ':)';
      1: Result := ':|';
      else Result := ':(';
    end;
  end;
begin
  if Key<>VK_BACK then
    exit;
  rve := (Sender as TCustomRichViewEdit).TopLevelEditor;
  if rve.SelectionExists then
    exit;
  ItemNo := rve.CurItemNo;
  Offs := rve.OffsetInCurItem;
  if (rve.GetItemStyle(ItemNo)=rvsBullet) and (Offs=1) then begin
    Key := 0;
    rve.SetSelectionBounds(ItemNo, 0, ItemNo, 1);
    rve.InsertText(GetSmile(GetBulletImageIndex), False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.rv5RVFImageListNeeded(Sender: TCustomRichView;
  ImageListTag: Integer; var il: TCustomImageList);
begin
  il := ImageList1;
end;
end.

						