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