StringGridのセル結合後，スクロールさせても正常に描画させるには？
解決いつも参考にさせて貰っています。
TStringGridのセル結合について不明点があるので教えてください。
過去ログを参考にセルの結合はできました。
ただ以下の条件の時に結合ができません。
・左スクロールさせた時（右スクロールは対応させました）
→ StringGrid1.LeftCol + 1 位置の描画が残っている
・スクロールさせた時の文字の描画
→ セル結合幅分で文字が描画されない為？
解決方法をご存じの方がいれば教えてください。
よろしくお願いします。
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.ColCount := 17;
StringGrid1.DefaultDrawing := False;
StringGrid1.Cells[1, 0] := 'A';
StringGrid1.Cells[2, 0] := 'A';
StringGrid1.Cells[3, 0] := 'A';
StringGrid1.Cells[4, 0] := 'A';
StringGrid1.Cells[5, 0] := 'B';
StringGrid1.Cells[6, 0] := 'B';
StringGrid1.Cells[7, 0] := 'B';
StringGrid1.Cells[8, 0] := 'B';
StringGrid1.Cells[9, 0] := 'C';
StringGrid1.Cells[10, 0] := 'C';
StringGrid1.Cells[11, 0] := 'C';
StringGrid1.Cells[12, 0] := 'C';
StringGrid1.Cells[13, 0] := 'D';
StringGrid1.Cells[14, 0] := 'D';
StringGrid1.Cells[15, 0] := 'D';
StringGrid1.Cells[16, 0] := 'D';
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
TmpValue: Integer;
RightCol: Integer;
DataPos: Array[1..4] of Integer;
//セルを伸ばす（セル結合）
procedure CellExtend(ColumnLeft, ColumnRight: Integer);
var
j: Integer;
TmpCount: Integer;
begin
with TStringGrid(Sender) do
begin
//左端から右へ
if (ACol = LeftCol) or (ACol = DataPos[ColumnLeft]) then
begin
if (RightCol >= DataPos[ColumnRight]) then
begin
for j := ACol + 1 to DataPos[ColumnRight] do
begin
Rect.Right := Rect.Right + ColWidths[DataPos[1]];
end;
end
else
begin
for j := ACol + 1 to RightCol do
begin
Rect.Right := Rect.Right + ColWidths[DataPos[1]];
end;
end;
end;
//右端から左へ
if (ACol = RightCol) or (ACol = DataPos[ColumnRight]) then
begin
if (LeftCol <= DataPos[ColumnLeft]) then
begin
for j := ACol - 1 downto DataPos[ColumnLeft] do
begin
Rect.Left := Rect.Left - ColWidths[DataPos[1]] - 1;
end;
end
else
begin
for j := ACol - 1 downto LeftCol do
begin
Rect.Left := Rect.Left - ColWidths[DataPos[1]] - 1;
end;
end;
end;
end;
end;
begin
//セル座標を１〜４で確認できるように補正
TmpValue := Trunc((ACol - 1) / 4);
DataPos[1] := (TmpValue * 4) + 1;
DataPos[2] := (TmpValue * 4) + 2;
DataPos[3] := (TmpValue * 4) + 3;
DataPos[4] := (TmpValue * 4) + 4;
with TStringGrid(Sender) do
begin
if gdFixed in State then
begin
//右側のセル位置取得
RightCol := VisibleColCount + LeftCol;
if ARow = 0 then
begin
CellExtend(1, 4);
end;
Canvas.Brush.Color := clBtnFace;
Canvas.Font.Color := clBlack;
Canvas.FillRect(Rect);
DrawEdge(Canvas.Handle, Rect, BDR_RAISEDINNER, BF_RECT);
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;
end;
end;
追記です。
右スクロールは対応と書きましたが対応できていませんでした。
色を毎回変えてRectの描画範囲を確認したところ，FillRectでは設定したRectの領域を塗りつぶさずに
スクロールした時に新しく表示された部分しか塗りつぶしていませんでした。
設定したRect領域を塗りつぶすにはどのようにすればいいでしょうか？
それとも考え方，やり方が根本的に間違っているのでしょうか・・・
って、どんな漢字？
type
TStringGrid = class(Grids.TStringGrid)
public
procedure WmHScroll(var Msg: TMessage); Message WM_HSCROLL;
end;
procedure TStringGrid.WmHScroll(var Msg: TMessage);
begin
inherited;
case LOWORD(Msg.wParam) of
SB_LINELEFT,SB_LINERIGHT,SB_PAGELEFT,SB_PAGERIGHT: Form1.StringGrid1.Invalidate;
end;
end;
スクロールした時の再描画を追加してやればいいということね。
返信ありがとうございます。
今，テストできる環境にありませんので後日連絡させてもらいます。
ありがとうございました。
教えていただいたコードでマウスでのスクロールに対応させることが出来ました。
ありがとうございます。
ただ，カーソルキーでセルを移動させた時にスクロールすると描画が正しくできません。
これは同じようにカーソルキーを押した時，又はフォーカスが移動した時に再描画処理を加えればいいのでしょうか？
教えていただいたコードがどういう仕組みになっているかまだ理解できていないので手助けして頂ければと思います。
こちらも勉強しながら調べてみます。
って、ドコが同文だょ。
type
TStringGrid = class(Grids.TStringGrid)
private
procedure WmHScroll(var Msg: TMessage); Message WM_HSCROLL;
procedure WmKeyDown(var Msg: TMessage); Message WM_KEYDOWN;
end;
//type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
.........
implementation
procedure TStringGrid.WmHScroll(var Msg: TMessage);
begin
inherited;
case LOWORD(Msg.wParam) of
SB_LINELEFT,SB_LINERIGHT,SB_PAGELEFT,SB_PAGERIGHT,SB_THUMBPOSITION : Form1.StringGrid1.Invalidate;
end;
end;
procedure TStringGrid.WmKeyDown(var Msg: TMessage);
begin
inherited;
with Form1.StringGrid1 do begin
case LOWORD(Msg.wParam) of
VK_LEFT :
begin
if LeftCol > 1 then begin
LeftCol := LeftCol-1; // お好みで削除するも良し
Invalidate;
end;
end;
VK_RIGHT :
begin
if LeftCol < ColCount-5 then begin
LeftCol := LeftCol+1; // お好みで削除するも良し
Invalidate;
end;
end;
end;
end;
end;
procedure TForm1. .....
begin
......
ただし、このTForm1の宣言の前で新クラス宣言する方法では、フォーム上に複数のStringGridが存在すると、
別のStringGridにフォーカスがある時に予期せぬ動作をすること蟻。
それがイヤなら、ここ↓を見て StringGrid1のCloneを作るも吉。
https://www.petitmonte.com/bbs/answers?question_id=5350
返信ありがとうございます。
WindowProcでメッセージ掴めば良いのかな？と試行錯誤していましたが，
単純にKEYDOWNでやるのが簡単そうですね。
しかしWmHScrollでは必要な時のみ再描画されますが，KEYDOWN時となると
カーソルキー入力時に常に再描画されて若干ちらつくのが気になります。
ちらつき部分の対処はもう少し考えてみます。
スクロール時の描画問題に関しては正常に描画されますので解決とさして頂きます。
本当に助かりました。ありがとうございます。
解決忘れました・・・
チラつくのは、StringGridの背景も再描画されるから...
type
TStringGrid = class(Grids.TStringGrid)
private
procedure WmHScroll(var Msg: TMessage); Message WM_HSCROLL;
procedure WmKeyDown(var Msg: TMessage); Message WM_KEYDOWN;
procedure WmEraseBkGnd(var Msg: TMessage); Message WM_ERASEBKGND; // コレ追加
end;
procedure TStringGrid.WmEraseBkGnd(var Msg: TMessage);
begin
; // 背景描画もナンもしない
end;
また知らないのが・・・
勉強になります。ありがとうございました。
| ツイート |  |