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

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

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

:: MVP ::

:: RSS ::

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

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

uses
  {...,} RichEdit;

// Стили подчеркивания
const
  CFU_UNDERLINETHICK = 9;
  CFU_UNDERLINEWAVE = 8;
  CFU_UNDERLINEDASHDOTDOT = 7;
  CFU_UNDERLINEDASHDOT = 6;
  CFU_UNDERLINEDASH = 5;
  CFU_UNDERLINEDOTTED = 4;
  CFU_UNDERLINE = 1;
  CFU_UNDERLINENONE = 0;

implementation

procedure RE_SetCharFormat(ARichEdit: TRichEdit; AUnderlineType: Byte; AColor: Word);
var
  // Структура CHARFORMAT2 содержит информацию о форматировании
  // текста, в редакторах, поддерживающий обогощенный формат (RTF)
  Format: CHARFORMAT2;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_UNDERLINETYPE;
    bUnderlineType := AUnderlineType or AColor;
    ARichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetCharFormat(RichEdit1, CFU_UNDERLINEWAVE, $50);
end;


Как изменить цвет фона у выделенного текста в TRichEdit?

uses
  {...,} RichEdit;

procedure RE_SetSelBgColor( RichEdit: TRichEdit; AColor: TColor );
var
  Format: CHARFORMAT2;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_BACKCOLOR;
    crBackColor := AColor;
    Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetSelBgColor(RichEdit1, clYellow);
end;


Как добавить цветную строку в TRichEdit?

procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
  with ARichEdit do
  begin
    SelStart := Length(Text);
    SelAttributes.Color := AColor;
    SelAttributes.Size := 8;
    SelAttributes.Name := 'MS Sans Serif';
    Lines.Add(AText);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AddColoredLine(RichEdit1, 'Hallo', clRed);
end;


Как изменить цвет текста определенной строки в TRichEdit?

procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
begin
  with ARichEdit do
  begin
    if ARow-1 < Lines.Count then
    begin
      SelStart := SendMessage(Handle, EM_LINEINDEX, ARow-1, 0);
      SelLength := Length(Lines[ARow-1]);
      SelAttributes.Color := AColor;
      SelLength := 0;
    end;
  end;
end;

// Меняем цвет текста во второй строке на синий
procedure TForm1.Button1Click(Sender: TObject);
const
  LineNumber = 2;
begin
  RE_ColorLine(RichEdit1, LineNumber, clBlue);
end;


Как перейти на нужную строку в TRichEdit?

procedure RE_GoToLineNumber( ARichEdit: TRichEdit; LineNumber: Word );
begin
  with ARichEdit do
  begin
    SelStart := perform(EM_LINEINDEX, LineNumber-1, 0);
    Perform(EM_SCROLLCARET, 0, 0);
    SetFocus;
  end;
end;

// Переходим на первую строку
procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_GoToLineNumber(RichEdit1, 1);
end;


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

const
  NewLimit = 3;

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Perform(EM_LIMITTEXT, NewLimit, 0);
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(RichEdit1.Handle, EM_EXLIMITTEXT, 0, NewLimit);
end;

// NewLimit - это ограничение по количеству символов. Причем символ
// конца строки (#10#13) считается равным двум символам. Таким образом,
// если NewLimit будет равен 2, то вы сможете либо напечатать два
// символа, либо сделать один перенос строки. Если передать в качестве
// размера 0, то ОС ограничивает размер OS Specific Default Value.
// Если вы воспользуетесь первым способом, то при каждом открытии файла
// это действие необходимо будет повторять. Воспользовавшись вторым
// способом, его достаточно сделать один раз.


Как получить слово под курсором в TRichEdit?

procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var 
  iCharIndex, iLineIndex, iCharOffset, i, j: Integer;
  Pt: TPoint;
  s: string;
begin
  with TRichEdit(Sender) do
  begin
    Pt := Point(X, Y);

    iCharIndex := Perform(Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
    if iCharIndex < 0 then
       Exit;

    iLineIndex := Perform(EM_EXLINEFROMCHAR, 0, iCharIndex);
    iCharOffset := iCharIndex - Perform(EM_LINEINDEX, iLineIndex, 0);
    if Lines.Count - 1 < iLineIndex then
       Exit;

    s := Lines[iLineIndex];
    i := iCharOffset + 1;

    while (i > 0) and (s[i] <> ' ') do
       Dec(i);

    j := iCharOffset + 1;
    while (j <= Length(s)) and (s[j] <> ' ') do
       Inc(j);

    Caption := Copy(s, i, j-i);
  end;
end;


Как получить первую видимую строку в TRichEdit?

function RE_GetFirstVisibleLine( RichEdit: TRichEdit ): integer;
begin
  Result := RichEdit.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(RE_GetFirstVisibleLine(RichEdit1)));
end;


Как получить последнюю видимую строку в TRichEdit?

uses
  {...,} RichEdit;

function RE_GetLastVisibleLine( RichEdit: TRichEdit ): integer;
const
  EM_EXLINEFROMCHAR = WM_USER + 54;
var
  r: TRect;
  i: integer;
begin
  RichEdit.Perform(EM_GETRECT, 0, Longint(@r));
  r.Left := r.Left + 1;
  r.Top  := r.Bottom - 2;
  i := RichEdit.Perform(EM_CHARFROMPOS, 0, Integer(@r.topleft));
  Result := RichEdit.Perform(EM_EXLINEFROMCHAR, 0, i);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(RE_GetLastVisibleLine(RichEdit1)));
end;


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

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

function SearchAndReplace(RichEdit: TRichEdit; SearchText, ReplaceText: 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(RichEdit.Text) - StartPos;
      Pos := FindText(SearchText, StartPos, EndPos, [stMatchCase]);
      Inc(StartPos, Length(SearchText));
      SetFocus;
      SelStart := Pos;
      SelLength := Length(SearchText);
      ClearSelection;
      SelText := ReplaceText;
    end;
    Lines.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SearchAndReplace(RichEdit1, 'OldText', 'NewText');
end;

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