文字列の色付け






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









Back