Stringgridのセル内複数行表示の色つけについて (ID：45763)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

参考程度程度のサンプルですが、
キャンバスに色付きテキストを描いてみました。

procedure DrawColorText(aCanvas:TCanvas; const aRect:TRect; const aText:string);
var
  tw,th,ch,cw:Integer;
  i: Integer;
const
  RedChar  = '父雄牡♂兄弟123'; //赤にしたい文字
  BlueChar = '母雌牝♀姉妹456'; //青にしたい文字
  TabSize  = 50;
procedure DrawReturn;
begin
  inc(th,ch);
  tw := aRect.Left;
end;
begin
  tw := aRect.Left;
  th := aRect.Top;
  ch := aCanvas.TextHeight('l');
  aCanvas.Lock;
  for i := 1 to Length(aText) do
  begin
    case Word(aText[i]) of
      $A:;
      $D:DrawReturn; //改行
      $9:begin;//Tagを実装するならここに記述
        tw := ((tw div TabSize)+1) * TabSize;
      end;
      else begin
        if Pos(aText[i],BlueChar)>0 then
          aCanvas.Font.Color := clBlue else
        if Pos(aText[i],RedChar)>0 then
          aCanvas.Font.Color := clRed else
          aCanvas.Font.Color := clWindowText;
        cw := aCanvas.TextWidth(aText[i]);
        if tw+cw > aRect.Right then //右側で折り返し
          DrawReturn;
        aCanvas.TextOut(tw,th,aText[i]);
        inc(tw,cw);
      end;
    end;
  end;
  aCanvas.Unlock;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Brush.Style := bsClear;
  DrawColorText(Canvas, Rect(0,0,Memo1.Width, Memo1.Height), Memo1.Text);
end;

←解決時は質問者本人がここをチェックしてください。

戻る