uses RichEdit;
var
fMyColor : TColor;
procedure MySearch_Color(RichEdit1: TRichEdit;fs: String;faColor: TColor ; fbColor: TColor);
var
FoundAt: LongInt;
StartPos, ToEnd: integer;
CFmt: TCharFormat;
begin
if RichEdit1.Lines.Count = 0 then Exit;
with RichEdit1 do
begin
StartPos := 0;
{ ToEnd は検索範囲の文字数 }
ToEnd := Length(Text) - StartPos;
FoundAt := FindText(fs, StartPos, ToEnd, [stMatchCase]);
// RichEdit1.Lines.BeginUpdate;
While FoundAt <> -1 do
begin
ToEnd := Length(Text) - StartPos;
FoundAt := FindText(fs, StartPos, ToEnd, [stMatchCase]);
SetFocus;
FillChar(CFmt, SizeOf(CFmt), 0);
CFmt.cbSize := sizeof(CFmt);
CFmt.dwMask := CFM_COLOR;
CFmt.crTextColor := ColorToRGB(faColor);
RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFmt));
SelStart := FoundAt;
SelLength := Length(fs);
StartPos := FoundAt + Length(fs);
end;
//キー入力を正常に処理する為にFontColorを戻しておく
CFmt.cbSize := sizeof(CFmt);
CFmt.dwMask := CFM_COLOR;
CFmt.crTextColor := ColorToRGB(fbColor);
RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFmt));
//RichEdit1.Lines.EndUpdate;
RichEdit1.SelLength := 0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.Font.Color := clBlack;
RichEdit1.HideSelection := False;//スクロールさせる
RichEdit1.Color := $00D8E4EF;
//clWindow のままだと色付け後 Copyすると選択文字列が白ける?
end;
procedure ClearSelColor(RichEdit: TRichEdit; BColor: TColor);
var
Format: TCHARFORMAT;
begin
FillChar(Format, SizeOf(Format), 0);
with Format do begin
cbSize := SizeOf(Format);
dwMask := CFM_COLOR;
crTextColor := BColor;
RichEdit.Perform(EM_SETCHARFORMAT, SCF_ALL, Longint(@Format));
end;
end;
procedure TForm1.ColorButtonClick(Sender: TObject);
begin
//前に付けた色クリアーするかしないか
ClearSelColor(RichEdit1, RichEdit1.Font.Color);
//特定文字列 Edit1.Text の色付け
MySearch_Color(RichEdit1,Edit1.Text,fMyColor,RichEdit1.Font.Color);
end;
APIで色を付けると SelAttributes.Color より強力で 64KB以上でも可能ですが、
その分、弊害が出ることもあります
|