StringGridのセル結合後，スクロールさせても正常に描画させるには？ (ID:30223)

名前

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

本文

いつも参考にさせて貰っています。
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;

//右端から左へ
      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;

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;

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

戻る