RichEdit经典问答FAQ

with RichEdit1 do
begin
   SelStart :=FindText('word',0,GetTextLen,[stWholeWord]);
   SelLength := 4; // select the word
   SelAttributes.color:=clBlue;
   SelLength:=0; // de-select the word
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  start: integer;
begin
  start := RichEdit1.FindText(Edit1.Text, 0, -1, [stMatchCase]);
  if start > -1 then
    with RichEdit1 do begin
      SelStart  := start;
      SelLength := Length(Edit1.Text);
      SelAttributes.Style := [fsItalic];
      SelLength := 0;
    end;
  RichEdit1.SetFocus;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 with RichEdit1 do
 begin
   Lines.Clear;
   SelStart := 0;  // position to top of box
   SelLength := 0; // nothing is selected
   // Set the desired style for the first text
   SelAttributes.Style := SelAttributes.Style - [fsBold];
   // insert this text at the beginning of the box:
   SelText := 'The dog';
   // Position to point of insertion, but don't select anything.
   // Set the SelAttrib's and insert the text at the point of the caret.
   SelStart := 3;     // point after "The"
   SelLength := 0;
   SelAttributes.Style := SelAttributes.Style + [fsBold];
   SelText := ' big';  // it was a big dog!
 end;
end;

var
  ms: TMemoryStream;
begin
  ms:= TMemoryStream.Create;
  RichEdit1.Lines.SaveToStream(ms);
  ms.Position:=0;
  RichEdit2.Lines.LoadFromStream(ms);
  ms.Free;
end;

  RichEdit1.Lines.LoadFromFile('C:\Temp\Test1.RTF');
  RichEdit2.Lines.LoadFromFile('C:\Temp\Test2.RTF');
  RichEdit2.Lines.AddStrings(RichEdit1.Lines);     // Infinite Loop ?
  RichEdit2.Lines.SaveToFile('C:\Temp\Test.RTF');

var
 ScrollMessage:TWMVScroll;
...
 {scroll the edit box all the way down}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_Bottom;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);
 {scroll the edit box all the way up}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_Top;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);
 {one page-up}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_PageUp;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);
 {one page-down}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_PageDown;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);

With RichEdit1 do
begin
  Lines.Clear;
  PlainText := not IsRtfFile(FileName);
  // If PlainText is true, then we will NOT look for RTF tags in the input
  DefAttributes.Name:='Fontname';
  DefAttributes.size:=fontsize;
  DefAttributes.color:=clRed;
  DefAttributes.style:=DefAttributes.style + [fsBold];
  Lines.LoadFromFile(Filename);
 end;

procedure GetEditColRow( CustEdit: TCustomEdit; var Col, Row: Integer );
begin
  Row := SendMessage(CustEdit.Handle, EM_LINEFROMCHAR, CustEdit.SelStart, 0);
  Col := Edit.SelStart - SendMessage(CustEdit.Handle, EM_LINEINDEX, -1, 0);
end;

RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, Row, 0) + Column;
RichEdit1.Perform(EM_SCROLLCARET, 0, 0);

  if Screen.ActiveControl is TRichEdit then
     TRichEdit(Screen.ActiveControl).SetFocus;

procedure TForm1.Button1Click(Sender: TObject);
Begin
  With RichEdit1 Do Begin
    // insert some text now
    Lines.Add('normal bold');
    // later, change it's attributes
    SelStart := SelStart-6;    { position to the b of bold }
    SelLength := 4;            { select the word }
    SelAttributes.Style := [fsBold];   { set boldface style for it }
    SelStart := Perform(EM_LINEINDEX, Pred(Lines.Count), 0);
                               { position to start of added line }
    SelLength := 6;            { select "normal" }
    SelAttributes.Color := clRed;  { color it red }
    SelLength := 0;            { remove selection }
    SetFocus;                  { activate control }
  End;
End;

procedure TMainForm1.FindDialog1Find(Sender: TObject);
var
 I, J, PosReturn, SkipChars: Integer;
begin
 For I := 0 to RichEdit1.Lines.Count do
 begin
   PosReturn := Pos(FindDialog1.FindText,RichEdit1.Lines[I]);
   if PosReturn <> 0 then {found!}
     begin
       Skipchars := 0;
       for J := 0 to I - 1 do
         Skipchars := Skipchars + Length(RichEdit1.Lines[J]);
       SkipChars := SkipChars + (I*2);
       SkipChars := SkipChars + PosReturn - 1;
       RichEdit1.SetFocus;
       RichEdit1.SelStart := SkipChars;
       RichEdit1.SelLength := Length(FindDialog1.FindText);
     end;
 end;
end;

procedure TMainForm.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  mpt: TPoint;
  cr,ccr: TCharRange;
  i: Integer;
begin
  i := SendMessage(RichEdit1.Handle,EM_EXGETSEL,0,longInt(@ccr));
  mpt.x := x;
  mpt.y := y;
  i := SendMessage(RichEdit1.Handle,EM_CHARFROMPOS,0,LongInt(@mpt));
  cr.cpmin := i;
  cr.cpMax := i;
  i := SendMessage(RichEdit1.Handle,EM_EXSETSEL,0,longInt(@cr));
  if (fsBold in Richedit1.SelAttributes.Style) and
     (fsUnderline in RichEdit1.SelAttributes.Style) then
        Screen.Cursor := crHand
  else
        Screen.Cursor := crDefault;
  i := SendMessage(RichEdit1.Handle,EM_EXSETSEL,0,longInt(@ccr));
end;

var
 ScrollMessage:TWMVScroll;
...
 {scroll the edit box all the way down}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_Bottom;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);
 {one page-up}
 ScrollMessage.Msg:=WM_VScroll;
 ScrollMessage.ScrollCode:=sb_PageUp;
 ScrollMessage.Pos:=0;
 RichEdit.Dispatch(ScrollMessage);

procedure SetTabstops(..)
var
 TabStops: array[0..3] of word;
begin
 TabStops[0]:=10;
 TabStops[1]:=20;
 TabStops[2]:=30;
 TabStops[3]:=40;
 TS:=SendMessage(RichEdit.Handle, EM_SETTABSTOPS, 4, LPARAM(@TabStops));
end;

const
  TabStops := 4;
var
  i: Integer;
begin
  RichEdit1.SelectAll;
  With RichEdit1.Paragraph do
  begin
     TabCount := 40;  // number of tab stops
     for i:=0 to TabCount do
        Tab[i] := (i+1)*TabStops;
  End;
  RichEdit1.SelLength := 0;
end;

procedure TForm1.LoadFile1Click(Sender: TObject);
var
 data: string;
 linecount: integer;
 infile: textfile;
begin
 assignfile(infile,'c:\text\Bible\kjv.txt');
 reset(input);
 if (IOresult<>0) then exit;
 RichEdit1.lines.clear;
 linecount:=0;
 RichEdit1.visible:=false;
 RichEdit1.MaxLength := High (Integer) - 1024;
 while not eof(infile) do
 begin
   readln(infile,data);
   inc(linecount);
   if linecount mod 50 = 0 then
      Application.ProcessMessages;  // This is a friendly thing to do
   RichEdit1.lines.add(inttostr(linecount)+' '+data);
 end;
 closefile(infile);
 RichEdit1.visible:=true;
end;

function GetWord: boolean;
var
  s: string; {presume no word > 255 chars}
  c: char;
begin
  result:= false;
  s:= ' ';
  while not eof(f) do
  begin
     read(f, c);
     if not (c in ['a'..'z','A'..'Z'{,... etcetera}]) then
        break;
     s:=s+c;
  end;
  result:= (s<>' ');
end;

procedure GetWordCount(TextFile: string);
begin
  Count:= 0;
  assignfile(f, TextFile);
  reset(f);
  while not eof(f) do
     if GetWord then inc(Count);
  closefile(f);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Range: TFormatRange;
 LastChar, MaxLen, LogX, LogY: Integer;
begin
 FillChar(Range, SizeOf(TFormatRange), 0);
 with Image1, Range do
 begin
   LogX := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
   LogY := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
   hdc := Canvas.Handle;
   hdcTarget := hdc;
   rc.right := Image1.ClientWidth * 1440 div LogX;
   rc.bottom := Image1.ClientHeight * 1440 div LogY;
   rcPage := rc;
   LastChar := 0;
   MaxLen := GetTextLen;
   chrg.cpMax := -1;
   repeat
     chrg.cpMin := LastChar;
     LastChar := SendMessage(RichEdit1.Handle, EM_FORMATRANGE, 1,
                             Longint(@Range));
   until (LastChar >= MaxLen) or (LastChar = -1);
 end;
 SendMessage(RichEdit1.Handle, EM_FORMATRANGE, 0, 0);
end;

function TMyForm.ScrollBarVisible(code: word): boolean;
var
 min, max: Integer;
begin
 result := False;
 if (MyRichEdit.ScrollBars = ssBoth) or
    ((code = SB_HORZ) and (MyRichEdit.ScrollBars = ssHorizontal)) or
    ((code = SB_VERT) and (MyRichEdit.ScrollBars = ssVertical)) then
     begin
       GetScrollRange(MyRichEdit..Handle, code, min, max);
       { !!! Sometimes GetScrollRange returns 0 for min and 100 for max, even
             though no scroll bar is visible. !!! }
       result := (min <> max);
     end;  { if }
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  theBStream: TBlobStream;
begin
  RichEdit1.Clear; // in case there is no RTF data in this record
  if Table1.State <> dsBrowse then
     Showmessage('Error: table not in browse mode to read RTF');
  if (not Table1.FieldByName('RTF').IsNull) then
  begin
     BlobStream:=nil;
     try
        BlobStream := Table1.CreateBlobStream(
              Table1.FieldByName('RTF') as TBlobField, bmRead);
        //ShowMessage('rtf blob size=' + IntToStr(BlobStream.Size));
        if BlobStream.Size > 0 then
           RichEdit1.Lines.LoadFromStream (BlobStream);
     finally
        if BlobStream <> nil then
           BlobStream.Free;
     end;
  end;
  RichEdit1.Modified:=False;
  SetModifiedIndicator(False);
end;

var
  BlobStream : TStream;
begin
  if (not Richedit1.Modified) then
     Exit;  // exit if the data in the RichEdit1 VCL was not changed
  BlobStream:=nil;
  try
     Table1.Edit;
     BlobStream := Table1.CreateBlobStream(
          Table1.FieldByName('RTF') as TBlobField, bmWrite);
     RichEdit1.Lines.SaveToStream(BlobStream);
     RichEdit1.Modified := False; // we saved the data, so start out fresh
  finally
     if BlobStream <> nil then
     begin
        BlobStream.Free; // IMPORTANT! Free the stream before doing the Post.
        // By free'ing first, it prevents possible trouble if you have an
        // OnDataChanged event handler that may change the current record
        // immediately after the post takes effect.
        try
           Table1.Post;
           dbiSaveChanges(Table1.Handle); // flush cache - in case of power failure
        except
           showmessage('Error while saving text');
        end;
     end;
     if Table1.State = dsEdit then
        Table1.Cancel;
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Label1: TLabel;
    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
type
  TMemoInfo = record
    Line: integer;
    Col:  integer;
  end;

procedure GetMemoPos(AMemo: TCustomMemo; var AMemoInfo:TMemoInfo);
begin
  with AMemo, AMemoInfo do begin
    { Line number of line containing cursor. }
    Line := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
    { Offset of cursor in line. }
    Col := SelStart - SendMessage(Handle, EM_LINEINDEX, Line, 0);
  end;
end;

procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  MemoInfo: TMemoInfo;
begin
  GetMemoPos(RichEdit1, MemoInfo);
  with MemoInfo do
    Label1.Caption := IntToStr(Succ(Line)) + ': ' + IntToStr(Succ(Col));
end;

end.

procedure TForm1.RichEdit1DragDrop( Sender, Source: TObject;
 X, Y: Integer );
begin
 if Source is TListView then
 begin
   SendMessage( RichEdit1.Handle, WM_LButtonDown, MK_LBUTTON,
     MakeLParam( X, Y ) );
   SendMessage( RichEdit1.Handle, EM_ReplaceSel, 1,
     LongInt( PChar( ListView1.Selected.Caption ) ) );
 end;
end;

    if Key = 'A' then begin
       ObjectThatGetsAs.Perform(WM_CHAR, ...);
       Key := char(0);
    end;

procedure TMainForm1.Button12Click(Sender: TObject);
var
 RichEdit: TRichEdit;
begin
 NoteBook1.Pages.Add('Untitled');
 TabSet1.Tabs.Assign(Notebook1.Pages);
 TabSet1.TabIndex := NoteBook1.Pages.Count - 1;
 RichEdit := TRichEdit.Create(self); // the form should be the Owner.
 // The Notebook page should be the Parent.
 RichEdit.Parent := Notebook1.Pages.Objects[Notebook1.PageIndex] as TPage;
end;

procedure TRichEditStrings.Put(Index: Integer; const S: string);
var
 Selection: TSelection;
begin
 if Index >= 0 then
 begin
   Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
   if Selection.StartPos <> -1 then
   begin
     Selection.EndPos := Selection.StartPos +
       SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
     SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos,
                 Selection.EndPos);
     SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
   end;
 end;
end;

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ComCtrls;

type
 TForm1 = class(TForm)
   RichEdit1: TRichEdit;
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
implementation

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
 Stream : TFileStream;
 Filer : TWriter;
begin
 Stream := nil;
 Filer := nil;
 try
   Stream := TFileStream.Create('c:\test.dat', fmCreate);
   Filer := TWriter.Create(Stream, 4096);
   Filer.WriteRootComponent(RichEdit1);
 finally
   Filer.Free;
   Stream.Free;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 Stream : TFileStream;
 Filer : TReader;
begin
 RichEdit1.Free;
 Stream := nil;
 Filer := nil;
 try
   RichEdit1.Free;
   Stream := TFileStream.Create('c:\test.dat', fmOpenRead);
   Filer := TReader.Create(Stream, 4096);
   Filer.Parent := Self;
   Filer.Owner := Self;
   Filer.ReadRootComponent(RichEdit1);
 finally
   Filer.Free;
 end;
end;

initialization
begin
 RegisterClass(TRichEdit);
end;

end.

procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
 var AllowChange: Boolean);
var
 S: String;
 CurrentCursorPos, FoundTextPos : longint;
begin
 RichEdit1.SelStart := 0;
 S := TabSet1.Tabs.Strings[NewTab];
 CurrentCursorPos:=RichEdit1.SelStart;
 FoundTextPos:=RichEdit1.FindText('CHAPTER'+' '+S,CurrentCursorPos+1,
                   RichEdit1.GetTextLen,[]);
 if FoundTextPos=-1 then begin
   MessageDlg('Text Not Found',mtError,[mbOK],0);
   RichEdit1.SelStart:=CurrentCursorPos;
 end
 else
 begin
   RichEdit1.SelStart:=FoundTextPos;
   SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0); <=== REPOSITION MEMO
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RichEdit1.Text:='Hello World!'#13#10'Hello World!';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 with RichEdit1 do
 begin
   SelStart:=0;
   SelLength:=12;
   SelAttributes.Name:='Wingdings';
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 cf:TCharFormat;
begin
 RichEdit1.SelStart:=14;
 RichEdit1.SelLength:=12;
 fillchar(cf,SizeOf(cf),#0);
 with cf do
 begin
   cbSize:=SizeOf(cf);
   dwMask:=CFM_FACE or CFM_CHARSET;
   bCharSet:=DEFAULT_CHARSET;
   bPitchAndFamily:=VARIABLE_PITCH;
   szFacename:='Wingdings';
 end;
 SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@cf));
end;

 with RichEdit1 do begin
   Clear;
   PlainText := false;
   Lines.LoadFromFile('QandD.Rtf');
   PlainText := true;
   Lines.SaveToFile('QandD.Txt');
 end;

 RichEdit.SelLength := 0;
 currentline := Richedit.Perform(EM_LINEFROMCHAR, Richedit.SelStart, 0 );
 Richedit.SelStart := richEdit.perform( EM_LINEINDEX, currentline+1, 0 );
 RichEdit.Perform( EM_SCROLLCARET, 0, 0 );

 RichEdit1.perform (WM_VSCROLL, SB_BOTTOM, 0)
 RichEdit1.perform (WM_VSCROLL, SB_PAGEUP, 0)

caretRow := Memo1.PerForm(EM_LINEFROMCHAR,Memo1.SelStart,0);
caretCol := Memo1.SelStart-Memo1.Perform(EM_LINEINDEX,caretRow,0);
line := memo1.lines[caretRow];

 Const
   wordchars = ['a'..'z','A'..'Z'];   { a set of char }
     {add other chars that are allowed in a word}
 Var
   line, theWord: String;
   n, wordstart, wordend: Integer;
 Begin
   line := RichEdit.Lines[currentlineindex];
   n := currentcolumnindex+1;
     { column indices are zero based, string indices are 1-based }
   if line[n] In wordchars Then Begin
     wordstart := n-1;
     While (wordstart >0) and (line[wordstart] In wordchars) Do
       Dec(wordstart);
     { we moved one position to far back, wordstart is now on the
       character before the word starts. Fix that. }
     Inc(wordstart);
     
     wordend := n+1;
     While( wordend <= Length(line)) and (line[wordend] In wordchars) Do
       Inc(wordend);
     { wordend is now one character beyond the end of the word }
       
     theWord := copy(line, wordstart, wordend-wordstart);  
   End {if}
   Else
     theWord := EmptyStr;
       { caret was not on a word }

var
 MemStream1: TMemoryStream;
begin
 { copy data from RTFEdit control to a std memo }
 MemStream1 := TMemoryStream.Create;
 RichEdit1.PlainText:=False;  { we want the rtf formatting stuff }
 RichEdit1.Lines.SaveToStream(MemStream1);
 MemStream1.Position := 0;
 RichEdit1.PlainText:=False;  { we want the rtf formatting stuff }
 Memo1.Lines.LoadFromStream(MemStream1);
 MemStream1.Free;
end;