StringGrid のOnDrawCell内で特定の条件で線を引く
解決皆さん、こんばんわ お世話になります。
少々頭が煮えています。
特定条件で
OnDrawCellのイベント内で特定条件で線を引こうとしました
---------------------------------------
var
TxtPotion :Cardinal;
intFontSize :Integer;
BufRect :TRect;
begin
// 表示時の反転色(青色)を表示させない処理
with TStringGrid(Sender ).Canvas do
begin
if ( gdSelected in State ) then
begin
Brush.Color := TStringGrid( Sender ).Color;
Font.Color := TStringGrid( Sender ).Font.Color;
end;
if (ARow > 0) and (ACol = 0) then
begin
FillRect( Rect );
end;
end;
// 文字の表示位置
if ARow = 0 then
begin
TxtPotion := DT_CENTER or DT_VCENTER Or DT_SINGLELINE; //センター
intFontSize := 11;
end else begin
if ACol in [0..4] then
begin
if ACol in [0,3,4] then
begin
TxtPotion := DT_RIGHT or DT_VCENTER Or DT_SINGLELINE; //右寄せ
intFontSize := 11;
end else if ACol = 1 then
begin
intFontSize := 10;
TxtPotion := DT_CENTER Or DT_EDITCONTROL; //２行に表示
if TStringGrid(Sender).Cells[51,ARow] = '1' then
begin
// 線を引きます
TStringGrid(Sender).Canvas.Pen.Color := clBlack;
TStringGrid(Sender).Canvas.MoveTo(Rect.Left,Rect.Bottom div 2);
TStringGrid(Sender).Canvas.LineTo(Rect.Right,Rect.Bottom div 2);
end;
end else
begin
TxtPotion := DT_LEFT or DT_VCENTER Or DT_SINGLELINE;
intFontSize := 11;
end;
end;
end;
TStringGrid(Sender ).Canvas.FillRect(Rect);
Rect.Top := Rect.Top + 2;
TStringGrid(Sender).Canvas.Font.Size := intFontSize;
DrawText(TStringGrid(Sender ).Canvas.Handle,PChar(TStringGrid(Sender ).Cells[ACol,ARow]),
Length(TStringGrid(Sender ).Cells[ACol,Arow]),Rect,TxtPotion);
end;
------------------------------------------------------------
ところが、条件に合った行のCell内に線を引かず、全然違う行のCellに線を
引いてしまいます。
何が悪いのかわかりません。
何方か、ご教授頂ければ幸いです。
>TStringGrid(Sender).Canvas.MoveTo(Rect.Left,Rect.Bottom div 2);
>TStringGrid(Sender).Canvas.LineTo(Rect.Right,Rect.Bottom div 2);
Y座標の計算がおかしいのでは？
線を引いた後で
TStringGrid(Sender ).Canvas.FillRect(Rect);
塗りつぶしているように見えます。
こんにちわ
Basserさん、HOtaさんありがとうございます。
言葉が足りなかったようです。m(__)m
StringGridで特定条件Cells[51,ARow]の値が'1'だったらCells[1,ARow]
のCell内に真ん中に横線を引こうと考えました。
結果を正しく見るために、Pen.Color := clRedに変えました。
ちなみに、RowCount:=4で全てのCells[51,ARow]の値を'1'にすると
1行目はCellの枠の上の線とCell内の真ん中に横線
2行目はCellの枠の上の線とCell内の真ん中に横線
の四本が引かれているようです。
上記の条件なら各Cellの真ん中に横線が表示されることを
期待したのですが・・・
//-------------------------------------------------------//
if ARow <> 0 then
begin
if ACol = 1 then
begin
if TStringGrid(Sender).Cells[51,ARow] = '1' then
begin
BufRect := TStringGrid(Sender).CellRect(ACol,ARow);
TStringGrid(Sender).Canvas.Pen.Color := clRed;
TStringGrid(Sender).Canvas.MoveTo(BufRect.Left ,(BufRect.Bottom div 2));
TStringGrid(Sender).Canvas.LineTo(BufRect.Right,(BufRect.Bottom div 2));
end;
end;
end;
//-------------------------------------------------------//
HOtaさんの言われたように、DrawTextの後に上記処理を移動しました。
が、結果的には同じになってしまいました。
すいません。文章が違ってました。
>ちなみに、RowCount:=4で全てのCells[51,ARow]の値を'1'にすると
FixedRows := 1 RowCount:=5です。
>1行目はCellの枠の上の線とCell内の真ん中に横線
>2行目はCellの枠の上の線とCell内の真ん中に横線
>の四本が引かれているようです。
の４本だけ引かれます。
こういうのが ドツボにハマった状態なんですかね...(^^ゞ
Canvas.MoveTo(Rect.Left, Rect.Top+(Rect.Bottom-Rect.Top) div 2);
Canvas.LineTo(Rect.Right,Rect.Top+(Rect.Bottom-Rect.Top) div 2);
土壷さん こんにちわ
そういうことだったんですね。
>こういうのが ドツボにハマった状態なんですかね...(^^
いや〜何て言うか・・・でした。
ありがとうございました。
| ツイート |  |