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

名前

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

本文

procedure TForm3.FormCreate(Sender: TObject);
begin
     StringGrid1.Cells[1,1] := '父'#13#10'母'#13#10'妹'#13#10'弟'#13#10;  //最後改行あり
     StringGrid1.Cells[2,1] := '父'#13#10'母'#13#10'妹';                  //最後改行なし
     StringGrid1.Cells[3,1] := '父'#13#10'母';
     StringGrid1.Cells[4,1] := '父母';
     StringGrid1.RowHeights[1] := 50;
end;

var
    FontColors: array[0..3] of TColor = (clRed,clBlue,clGreen,clYellow);

procedure TForm3.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
    C,I: Integer;
    S: String;
    FC: TColor;
begin

if not ( gdFixed in state ) then
    begin
      FC := StringGrid1.Font.Color;
      StringGrid1.Canvas.Brush.Color := StringGrid1.Color;
      StringGrid1.Canvas.FillRect(Rect);
      Text := StringGrid1.Cells[ACol,ARow]; //全体文字
      C := 0;
      while (Text <> '') do
      begin
        I := Pos ( #13#10,Text);
        if I<>0 then
        begin
          //改行あり
          S := Copy(Text,0,I);                   //改行までの文字
          Text := Copy(Text,I+2,Length(Text)-I); //Textを改行以降の文字にする
        end
        else
        begin
          //改行なし
          S := Text;
          Text := '';
        end;
        StringGrid1.Canvas.Font.Color := FontColors[C];
        StringGrid1.Canvas.TextRect(Rect,Rect.Left,Rect.Top,S);
        Rect.Top := Rect.Top + StringGrid1.Canvas.TextHeight(S);
        //Rect.top が Rect.Bottom を超えるのを防ぐ
        if ( Rect.Top > Rect.Bottom ) then Rect.Top := Rect.Bottom;
        Inc(C);
      end;
      StringGrid1.Canvas.Font.Color := FC;
    end;

end;

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

戻る