:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|