FAQ VCL
Компоненты\RichEdit

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как реализовать поиск текста в TRichEdit?

// Данная процедура осуществит поиск первого вхождения
// искомого текста в RichEdit. Если нужно найти слово
// целиком, делаем так: [stMatchCase,stWholeWord]

function SearchTextAndSelect(RichEdit: TRichEdit; SearchText: string): Boolean;
var 
  StartPos, EndPos, Pos: Integer;
begin 
  StartPos := 0;
  with RichEdit do
  begin
    EndPos := Length(Text);
    Lines.BeginUpdate;
    while FindText(SearchText, StartPos, EndPos, [stMatchCase]) <> -1 do
    begin
      EndPos := Length(Text) - StartPos;
      Pos := FindText(SearchText, StartPos, Endpos, [stMatchCase]);
      Inc( StartPos, Length(SearchText));
      SetFocus;
      SelStart := Pos;
      SelLength := Length(SearchText);
      Break;
    end;
    Lines.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SearchTextAndSelect(RichEdit1, 'SomeText');
end;


Как в TRichEdit при нажатии Enter позиционировать курсор в позицию, как в предыдущей строке?

uses
  {...,} RichEdit;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
  Line, Col, Indent: Integer;
  s: string;
begin
  if Key = #13 then
  begin
    Key := #0;
    with Sender as TRichEdit do
    begin
      Line := Perform(EM_EXLINEFROMCHAR, 0, SelStart);
      Col := SelStart - Perform(EM_LINEINDEX, Line, 0);
      s := Copy(Lines[Line], 1, Col);
      Indent := 0;
      while (Indent < Length(s)) and (s[Indent+1] in [' ', #9]) do
        Inc(Indent);
      SelText := #13#10 + Copy(s, 1, Indent);
    end;
  end;
end;


Как взять RTF отформатированный текст из TRichEdit?

function GetRTFText( RichEdit: TRichedit ): string;
var
  ss: TStringStream;
  EmptyStr: string;
begin
  EmptyStr := '';
  ss := TStringStream.Create(EmptyStr);
  try
    RichEdit.PlainText := False;
    RichEdit.Lines.SaveToStream(ss);
    Result := ss.DataString;
  finally
    ss.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := GetRTFText(RichEdit1);
end;


Как реализовать выравнивание текста в TRichEdit?

// Спосов первый
uses
  {...,} RichEdit;

procedure RE_AlignText( RichEdit: TRichEdit; Alignment: TAlignment );
var
  pf2: PARAFORMAT2;
begin
  FillChar(pf2, SizeOf(pf2), 0);
  pf2.cbSize := SizeOf(PARAFORMAT2);
  SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LongInt(@pf2));
  pf2.dwMask := PFM_ALIGNMENT;
  case Alignment of
    taLeftJustify: pf2.wAlignment := PFA_LEFT;
    taCenter: pf2.wAlignment := PFA_CENTER;
    taRightJustify: pf2.wAlignment := PFA_RIGHT;
  end;
  SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LongInt(@pf2));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_AlignText(RichEdit1, taRightJustify);
end;

// Спосов второй
procedure RE_AlignText( RichEdit: TRichEdit; Alignment: TAlignment );
begin
  RichEdit.Paragraph.Alignment := Alignment;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_AlignText(RichEdit1, taRightJustify);
end;


Как задать расстояние между строк в TRichEdit?

uses
  {...,} RichEdit;

procedure RE_SetLineSpacing(ARichEdit: TRichEdit; lineSpacing: Byte);
var
  pf2: ParaFormat2;
begin
  FillChar(pf2, SizeOf(pf2), 0);
  pf2.cbSize := SizeOf(PARAFORMAT2);
  pf2.dwMask := PFM_LINESPACING;
  pf2.bLineSpacingRule := lineSpacing;
  SendMessage(ARichEdit.Handle, EM_SETPARAFORMAT, 0, LongInt(@pf2));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetLineSpacing(RichEdit1, 1);
end;


Как скопировать содержимое одного RichEdit в другой?

procedure TForm1.Button1Click(Sender: TObject);
var
  MemoryStream: TMemoryStream;
begin
  MemoryStream := TMemoryStream.Create;
  try
    RichEdit1.Lines.SaveToStream(MemoryStream);
    MemoryStream.Seek(0, soFromBeginning);
    RichEdit2.Lines.LoadFromStream(MemoryStream);
  finally
    MemoryStream.Free;
  end;
end;


Как переместить курсор в TRichEdit на нужную позицию?

procedure RE_MoveTo(RichEdit: TRichEdit; LineNumber, CharNumber: Word);
begin
  RichEdit.SelStart := RichEdit.Perform(EM_LINEINDEX, LineNumber-1, 0) + CharNumber;
  RichEdit.SetFocus;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_MoveTo(RichEdit1, 4, 3);
end;


Как создать список в TRichEdit?

uses
  {...,} RichEdit;

procedure TForm1.Button1Click(Sender: TObject);
var
  fmt: TParaFormat2;
begin
   FillChar(fmt, SizeOf(fmt), 0);
   fmt.cbSize := SizeOf(fmt);
   fmt.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTART or
                 PFM_NUMBERINGSTYLE or PFM_NUMBERINGTAB;
   fmt.wNumbering := 2;
   // wNumbering:
   // 0 - нет нумерации
   // 1 - маркированный список    (·, ·, ·, ...).
   // 2 - арабские цифры          (1, 2, 3, ...).
   // 3 - маленькие буквы         (a, b, c, ...).
   // 4 - большие буквы           (A, B, C, ...).
   // 5 - маленькие римские цифры (i, ii, iii, ...).
   // 6 - большие римские цифры   (I, II, III, ...).
   // 7 - последовательность символов Unicode
   fmt.wNumberingStart := 1;
   // wNumberingStart:
   //  Число, с которого начинается нумерация.
   fmt.wNumberingStyle := $200;
   // wNumberingStyle:
   // Стиль нумерации
   // 0     :  1)
   // $100  : (1)
   // $200  :  1.
   // $300  :  1
   // $400  : убрать список
   // $8000 : продолжает нумеровать список не изменяя стиля
   fmt.wNumberingTab := 1440 div 4;
   // wNumberingTab:
   // расстояние между номером и текстом параграфа
   RichEdit1.Perform(EM_SETPARAFORMAT, 0, lParam(@fmt));
end;


Как изменить стиль шрифта TRichEdit нажатиями соответствующих клавиш?

// В примере стили шрифта меняются по нажатию следующих комбинаций клавиш:
// Ctrl + B - вкл/выкл жирного шрифта
// Ctrl + I - вкл/выкл наклонного шрифта
// Ctrl + S - вкл/выкл зачеркнутого шрифта
// Ctrl + U - вкл/выкл подчеркнутого шрифта

procedure RE_SetTextStyle(ARichEdit: TRichEdit; Style: TFontStyle);
begin
  case Style of
    fsBold:
      if fsBold in ARichEdit.SelAttributes.Style then
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style - [fsBold]
      else
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style + [fsBold];
    fsItalic:
      if fsItalic in ARichEdit.SelAttributes.Style then
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style - [fsItalic]
      else
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style + [fsItalic];
    fsUnderline:
      if fsUnderline in ARichEdit.SelAttributes.Style then
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style - [fsUnderline]
      else
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style + [fsUnderline];
    fsStrikeOut:
      if fsStrikeOut in ARichEdit.SelAttributes.Style then
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style - [fsStrikeOut]
      else
        ARichEdit.SelAttributes.Style := ARichEdit.SelAttributes.Style + [fsStrikeOut];
  end;
end;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
const
  KEY_CTRL_B = 2;
  KEY_CTRL_I = 9;
  KEY_CTRL_S = 19;
  KEY_CTRL_U = 21;
begin
  case Ord(Key) of
    KEY_CTRL_B: begin
      Key := #0;
      RE_SetTextStyle(Sender as TRichEdit, fsBold);
    end;
    KEY_CTRL_I: begin
      Key := #0;
      RE_SetTextStyle(Sender as TRichEdit, fsItalic);
    end;
    KEY_CTRL_U: begin
      Key := #0;
      RE_SetTextStyle(Sender as TRichEdit, fsUnderline);
    end;
    KEY_CTRL_S: begin
      Key := #0;
      RE_SetTextStyle(Sender as TRichEdit, fsStrikeOut);
    end;
  end;
end;


Как узнать цвет фона в позиции каретки в TRichEdit?

function RE_GetSelBgColor(RichEdit: TRichEdit): TColor;
var
  DC: HDC;
  Cur: TPoint;
begin
  DC := GetDC(0);
  GetCaretPos(Cur);
  Cur := RichEdit.ClientToScreen(Cur);
  Result := GetPixel(DC, Cur.X-1, Cur.Y);
  ReleaseDC(0, DC);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Caption := ColorToString(RE_GetSelBgColor(RichEdit1));
end;

При использовании материала - ссылка на сайт обязательна