Stringgridのセル内複数行表示の色つけについて
解決こんにちは。
Stringgridのdraw cellについての質問です。
セル内に複数行を改行を使って表示させているのですが、draw cellで色を分けて付ける方法を教えてください。
stringgrid1.cells［0,1］:＝'父'+#13#10+'母';
----------
Stringgrid1drawcell
Var
S:string;
begin
S:=stringgrid1.cells[acol,arow];
Stringgrid1.canvas.fillrect(rect);
Drawtextex(stringgrid1.canvas.handle,
Pchar(s),
Length(s),
Rect,
Dt_left,
Nil);
End;
以上のようなコードで表示させています。
父を赤色に、母を青色にする場合どのようにするのか教えてください。
"父"と"母"の二回に分けて描画します。
まずStringgrid1のCanvasのFontのColorを赤にして"父"を描画。
次にDrawtextexの戻り値を利用するなどしてRect.Topの値を調整。
そしてStringgrid1のCanvasのFontのColorを青にして"母"を描画。
多分こんな感じで。
参考程度程度のサンプルですが、
キャンバスに色付きテキストを描いてみました。
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;
Dさんminnaさんコメントありがとうございます。
理解するのに時間がかかるので参考にしながらやってみます。
こんにちは
stringgridのdrawcellを使っての描画の質問です。
------------------------------
stringgrid1.cells［0,1］:＝'父'+
#13#10+
'母';
------------------------------
一行目の父を青色
二行目の母を赤色に描画する場合
s:=stringgrid1.cells[Acol,Arow];
if((ARow=0) and (ACol=1)) then
with Canvas do begin
fillrect(rect);//一度表示を消す
Brush.Color:=clwhite;
Font.Color:=clblue;
DrawTextEx(StringGrid1.Canvas.Handle,
PChar(S),
Length(S),
Rect,
DT_left,
nil);
dt:=DrawTextEx(StringGrid1.Canvas.Handle,
PChar(S),
Length(S),
Rect,
DT_left,
nil);
if(dt>12)and(dt<=24)then begin
fillrect(rect);
Font.Color:=clred;
DrawTextEx(StringGrid1.Canvas.Handle,
PChar(S),
Length(S),
Rect,
DT_left,
nil);
end;
end;//
-------------------
以上のようなコードでdrawtextの戻り値を利用して見たのですが、表示は赤色になってしまいます。結局、戻り値の値だけで一行目二行目を判定できていません。Rect.topの値を調整するというのは、どのようにするのでしょうか？
procedure TForm3.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[1,1] := '父'#13#10'母';
StringGrid1.Cells[2,1] := '父母';
end;
procedure TForm3.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);
var
Text: String;
I,H: Integer;
S1,S2: String;
BRect: TRect;
begin
if not ( gdFixed in state ) then
begin
StringGrid1.Canvas.Brush.Color := StringGrid1.Color;
StringGrid1.Canvas.FillRect(Rect);
Text := StringGrid1.Cells[ACol,ARow]; //CELLのText
I := Pos ( #13#10,Text); //#13#10の位置取得
if ( I <> 0 ) then
begin
S1 := Copy(Text,0,I); //#13#10より前の文字
S2 := Copy(Text,I+2,Length(Text)-I); //#1310より後ろの文字
H := StringGrid1.Canvas.TextHeight(S1); //前の文字の高さ
//#13#10の前を描画
StringGrid1.Canvas.Font.Color := clRed;
StringGrid1.Canvas.TextRect(Rect,Rect.Left,Rect.Top,S1);
//#13#10の後を描画
BRect := Rect;
BRect.Top := BRect.Top + H;
StringGrid1.Canvas.Font.Color := clBlue;
StringGrid1.Canvas.TextRect(BRect,Rect.Left,Rect.Top+H,S2);
end
else
begin
//#13#10の無いCELL
StringGrid1.Canvas.Font.Color := StringGrid1.Font.Color;
StringGrid1.Canvas.TextRect(Rect,Text);
end;
end;
end;
KHE00221さん。早速の回答ありがとうございます。
思い通りに描画できました。
そこでもうひとつだけ、二行のやり方はわかりましたが、三行目もある場合
i:=ansipos(#13#10,text);
showmessage(inttostr(i));にして結果を見たところ１つだけしかヒットしませんでした。
S1 := Copy(Text,0,I); //#13#10より前の文字
S2 := Copy(Text,I+2,Length(Text)-I); //#1310より後ろの文字
'父'#13#10'母'#13#10'弟'
のように三行目の描画も教えてくさい。
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;
KHE00221さん。
Font colorを配列にするというアイデアは初心者には思いつきません。
サンプルコードありがとうございます。
色を付けるのは他にもしてみたいことがあります。
父母の父は青色に母は赤色にするとかです。
Drawcellの複雑な？色つけはposを利用して文字の長さを判定していくようにしていけばいいですか？
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[1,1] := 'Ａ父Ｂと11母22'#13#10'妹33'#13#10'44弟'#13#10; //最後改行あり
StringGrid1.Cells[2,1] := '父'#13#10'11母22'#13#10'妹'; //最後改行なし
StringGrid1.Cells[3,1] := '父'#13#10'母';
StringGrid1.Cells[4,1] := '父母';
StringGrid1.ColWidths[1] := 100;
StringGrid1.RowHeights[1] := 50;
end;
var
Keys: array[0..3] of String = ('父','母','妹','弟');
FontColors: array[0..3] of TColor = (clRed,clBlue,clGreen,clYellow);
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
I,J,K: Integer;
S1: String;
DefaultColor: TColor;
Text: String;
BRect: TRect;
begin
if not ( gdFixed in state ) then
begin
DefaultColor := StringGrid1.Font.Color;
StringGrid1.Canvas.Brush.Color := StringGrid1.Color;
StringGrid1.Canvas.FillRect(Rect);
Text := StringGrid1.Cells[ACol,ARow]; //全体文字
BRect := Rect;
I := 1;
while (I < Length (Text)) do
begin
K := -1;
for J := Low ( Keys ) to High ( Keys ) do
begin
if Copy(Text,I,Length(Keys[J])) = Keys[J] then K := J;
end;
if ( K <> -1 ) then
begin
StringGrid1.Canvas.Font.Color := FontColors[K];
StringGrid1.Canvas.TextRect(BRect,BRect.Left,BRect.Top,Keys[K]);
StringGrid1.Canvas.Font.Color := DefaultColor;
BRect.Left := BRect.Left + StringGrid1.Canvas.TextWidth(Keys[K]);
I := I + Length (keys[K]);
end
else
begin
if ( Copy(Text,I,2) = #13#10 ) then
begin
BRect.Left := Rect.Left;
BRect.Top := BRect.Top + StringGrid1.Canvas.TextHeight('A'); //A は適当
Inc(I);
end
else
begin
S1 := Copy(Text,I,1);
StringGrid1.Canvas.TextRect(BRect,BRect.Left,BRect.Top,S1);
BRect.Left := BRect.Left + StringGrid1.Canvas.TextWidth(S1);
end;
Inc(I);
end;
end;
StringGrid1.Canvas.Font.Color := DefaultColor;
end;
end;
| ツイート |  |