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以上でも可能ですが、 その分、弊害が出ることもあります |