StringGridセルの結合で・・・

解決

マリモ 2005-08-24 20:32:23 No: 17245

行間のセル結合したく、下のコードのようにして１列目の１行目〜３行目を結合しました。しかしながら、２列目の文字が描画がされません。
２列目のセルに一度フォーカスを移すと描画します。

なぜこのようになるのか、どのようにしたら２列目が普通に描画されるのか分かりません。
どなたか教えてください。宜しくお願いします。

procedure TForm1.FormCreate(Sender: TObject);
var
  r, c : SmallInt;
begin
  for r := 1 to 4 do
    for c := 1 to 4 do
      StringGrid1.Cells[r, c] := 'aaa';
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with TStringGrid(Sender) do begin

DefaultDrawing := True;

    if (ARow > 0) and (ACol = 1) then
    begin
      DefaultDrawing := False;
      case ARow of
        1 : Rect.Bottom := Rect.Bottom + RowHeights[2] +
                                         RowHeights[3];
        2 : Rect.Bottom := Rect.Bottom + RowHeights[3];
      end;

      case ARow of
        3 : Rect.Top  := Rect.Top - RowHeights[2] - RowHeights[1];
        2 : Rect.Top  := Rect.Top - RowHeights[1];
      end;
      Canvas.FillRect(Rect);

      DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect,
               DT_SINGLELINE or DT_CENTER or DT_VCENTER);
    end;

end;
end;

deldel 2005-08-25 17:59:13 No: 17246

結合の仕方は違いますが、うまくいっている例です。
参考になれば・・・

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with TStringGrid(Sender) do begin
    if ((ACol < 6) and (gdFixed in State) and (ARow < 2)) then begin
      case ARow of
        0 : Rect.Bottom  := Rect.Bottom  + RowHeights[1];
        1 : Rect.Top := Rect.Top - (RowHeights[0] + 1);
      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 else begin
      Canvas.Font.Color  := clBlack;

      if gdFixed in State then begin
        Canvas.Brush.Color := clBtnFace;
        Canvas.FillRect(Rect);
        DrawEdge(Canvas.Handle, Rect, BDR_RAISEDINNER, BF_RECT);
      end else begin
        Canvas.Brush.Color := clWindow;
        Canvas.FillRect(Rect);
      end;
      DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect,
         DT_SINGLELINE or DT_CENTER or DT_VCENTER);
    end;

    if gdFocused in State then
      Canvas.DrawFocusRect(Rect);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  C, R: Word;
begin
  for R := 0 to Pred(StringGrid1.RowCount) do begin
  for C := 0 to Pred(StringGrid1.ColCount) do begin
    StringGrid1.Cells[C, R] := inttostr(C) + ' , ' + inttostr(R);
  end;
  end;
end;

マリモ 2005-08-25 19:21:52 No: 17247

deldelさんありがとうございます。

いろいろと調べた結果

DefaultDrawing := False;

をやめると描画されました。
Trueの場合はデフォルトの描画に上書き描画するようですので。これで２列目も描画されました。

１列目の実行結果は微妙に違いますが、とりあえず解決です。