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;

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