TStringGrid 合并单元格绘图答案

【问题标题】：TStringGrid merge cell drawingTStringGrid 合并单元格绘图
【发布时间】：2015-01-02 06:51:33
【问题描述】：

此链接/图片显示了我尝试使用 TStringGrid 实现的目标。

此链接/图片显示了我下面的代码的结果。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  cProdWidth = 70;
  cCountWidth = 45;
  cWeightWidth = 55;
var
  Index: Integer;
  Col, Row: Integer;
begin
  StringGrid.ColCount := 10;
  StringGrid.RowCount := 2;
  StringGrid.Cells[1, 0] := 'Shoulder';
  StringGrid.ColWidths[1] := cProdWidth;
  StringGrid.Cells[4, 0] := 'Barrel';
  StringGrid.ColWidths[4] := cProdWidth;
  StringGrid.Cells[7, 0] := 'Leg';
  StringGrid.ColWidths[7] := cProdWidth;

  StringGrid.Cells[0, 1] := 'Carcass Prod';
  StringGrid.ColWidths[0] := cProdWidth;
  StringGrid.Cells[1, 1] := 'Product';
  StringGrid.Cells[2, 1] := 'Count';
  StringGrid.ColWidths[2] := cCountWidth;
  StringGrid.Cells[3, 1] := 'Weight %';
  StringGrid.ColWidths[3] := cWeightWidth;
  StringGrid.Cells[4, 1] := 'Product';
  StringGrid.Cells[5, 1] := 'Count';
  StringGrid.ColWidths[5] := cCountWidth;
  StringGrid.Cells[6, 1] := 'Weight %';
  StringGrid.ColWidths[6] := cWeightWidth;
  StringGrid.Cells[7, 1] := 'Product';
  StringGrid.Cells[8, 1] := 'Count';
  StringGrid.ColWidths[8] := cCountWidth;
  StringGrid.Cells[9, 1] := 'Weight %';
  StringGrid.ColWidths[9] := cWeightWidth;
  StringGrid.Invalidate;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  CellText: String;
begin
  if (ACol > 0)
    then begin
          CellText := StringGrid.Cells[ACol, ARow];
          if ((ARow = 0) and (ACol in [1, 4, 7]))
            then begin
                  // Attempt to merge 3 cells into one
                  Rect.Right := StringGrid.ColWidths[ACol] + StringGrid.ColWidths[ACol + 1] + StringGrid.ColWidths[ACol + 2];
                  StringGrid.Canvas.Brush.Color := clWindow;
                  StringGrid.Canvas.Brush.Style := bsSolid;
                  StringGrid.Canvas.Pen.Style := psClear;
                  StringGrid.Canvas.FillRect(rect);
                  DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
                 end;
          if (ACol in [1,2,3,7,8,9])
            then begin
                  StringGrid.Canvas.Brush.Color := clWebLinen;
                  StringGrid.Canvas.FillRect(Rect);
                 end
            else StringGrid.Canvas.Brush.Color := clWindow;
          if (ARow > 0)
            then StringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top, CellText);
         end;
end;

end.

这是我的 unit1.dfm 文件内容。

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 371
  ClientWidth = 606
  Color = clBtnFace    
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object StringGrid: TStringGrid
    Left = 0
    Top = 0
    Width = 606
    Height = 371
    Align = alClient
    ColCount = 1
    FixedCols = 0
    RowCount = 1
    FixedRows = 0
    TabOrder = 0
    OnDrawCell = StringGridDrawCell
    ExplicitLeft = 160
    ExplicitTop = 88
    ExplicitWidth = 320
    ExplicitHeight = 120
  end
end

问题似乎在于StringGridDrawCell 中的合并代码，就在//Attempt to merge 3 cells into one 注释下方。

我确信这可能是显而易见的，但我这辈子都看不到。

注意：如果有人可以将链接转换为嵌入图像，我将不胜感激，因为我似乎没有足够的声誉来发布图像。

【问题讨论】：

标签： delphi delphi-2006 tstringgrid

【解决方案1】：

试试这个：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid: TStringGrid;
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  cProdWidth = 70;
  cCountWidth = 45;
  cWeightWidth = 55;
  cNoSelection: TGridRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
begin
  StringGrid.ColCount := 10;
  StringGrid.RowCount := 3;
  StringGrid.FixedRows := 2;

  StringGrid.RowHeights[0] := StringGrid.Canvas.TextHeight('Shoulder') + 4;
  StringGrid.RowHeights[1] := (StringGrid.Canvas.TextHeight('Carcass Product') + 4) * 2;

  StringGrid.ColWidths[0] := cProdWidth;
  StringGrid.ColWidths[1] := cProdWidth;
  StringGrid.ColWidths[2] := cCountWidth;
  StringGrid.ColWidths[3] := cWeightWidth;
  StringGrid.ColWidths[4] := cProdWidth;
  StringGrid.ColWidths[5] := cCountWidth;
  StringGrid.ColWidths[6] := cWeightWidth;
  StringGrid.ColWidths[7] := cProdWidth;
  StringGrid.ColWidths[8] := cCountWidth;
  StringGrid.ColWidths[9] := cWeightWidth;

  StringGrid.Cells[1, 0] := 'Shoulder';
  StringGrid.Cells[4, 0] := 'Barrel';
  StringGrid.Cells[7, 0] := 'Leg';

  StringGrid.Cells[0, 1] := 'Carcass'#10'Product';
  StringGrid.Cells[1, 1] := 'Product';
  StringGrid.Cells[2, 1] := 'Count';
  StringGrid.Cells[3, 1] := 'Weight %';
  StringGrid.Cells[4, 1] := 'Product';
  StringGrid.Cells[5, 1] := 'Count';
  StringGrid.Cells[6, 1] := 'Weight %';
  StringGrid.Cells[7, 1] := 'Product';
  StringGrid.Cells[8, 1] := 'Count';
  StringGrid.Cells[9, 1] := 'Weight %';

  StringGrid.Cells[0, 2] := '22-110';
  StringGrid.Cells[1, 2] := '22-120';
  StringGrid.Cells[2, 2] := '2';
  StringGrid.Cells[3, 2] := '35';
  StringGrid.Cells[4, 2] := '22-130';
  StringGrid.Cells[5, 2] := '1';
  StringGrid.Cells[6, 2] := '25';
  StringGrid.Cells[7, 2] := '22-140';
  StringGrid.Cells[8, 2] := '2';
  StringGrid.Cells[9, 2] := '40';

  StringGrid.Selection := cNoSelection;
  StringGrid.Invalidate;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  CellText: String;
begin
  Rect := StringGrid.CellRect(ACol, ARow);

  if ARow = 0 then
  begin
    case ACol of
      1, 4, 7: begin
        Rect.Right := Rect.Right + StringGrid.GridLineWidth;
      end;
      2, 5, 8: begin
        Rect.Left := Rect.Left - StringGrid.GridLineWidth;
        Rect.Right := Rect.Right + StringGrid.GridLineWidth;
      end;
      3, 6, 9: begin
        Rect.Left := Rect.Left - StringGrid.GridLineWidth;
      end;
    end;
    case ACol of
      0, 4..6: begin
        StringGrid.Canvas.Brush.Color := clWindow;
      end;
      1..3, 7..9: begin
        StringGrid.Canvas.Brush.Color := clWebLinen;
      end;
    end;
  end else
  begin
    if (State * [gdSelected, gdRowSelected]) <> [] then
      StringGrid.Canvas.Brush.Color := clHighlight
    else
      StringGrid.Canvas.Brush.Color := clWindow;
  end;

  StringGrid.Canvas.Brush.Style := bsSolid;
  StringGrid.Canvas.Pen.Style := psClear;
  StringGrid.Canvas.FillRect(Rect);

  StringGrid.Canvas.Brush.Style := bsClear;
  StringGrid.Canvas.Pen.Style := psSolid;
  StringGrid.Canvas.Pen.Color := clWindowText;

  if ARow = 0 then
  begin
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top);

    case ACol of
      0, 1, 4, 7: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom);
  end
  else if ARow = 1 then
  begin
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top);

    case ACol of
      1..9: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom-1);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
  end
  else begin
    case ACol of
      1..9: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;
  end;

  if (State * [gdSelected, gdRowSelected]) <> [] then
  begin
    StringGrid.Canvas.Brush.Color := clHighlight;
    StringGrid.Canvas.Font.Color := clHighlightText;
  end else
  begin
    StringGrid.Canvas.Brush.Color := clWindow;
    StringGrid.Canvas.Font.Color := clWindowText;
  end;
  StringGrid.Canvas.Brush.Style := bsClear;

  if ARow = 0 then
  begin
    case ACol of
      1..3: begin
        Rect.TopLeft := StringGrid.CellRect(1, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(3, 0).BottomRight;
        CellText := StringGrid.Cells[1, 0];
      end;
      4..6: begin
        Rect.TopLeft := StringGrid.CellRect(4, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(6, 0).BottomRight;
        CellText := StringGrid.Cells[4, 0];
      end;
      7..9: begin
        Rect.TopLeft := StringGrid.CellRect(7, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(9, 0).BottomRight;
        CellText := StringGrid.Cells[7, 0];
      end;
    end;

    Rect.Inflate(-2, -2);
    DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
  end
  else if ARow = 1 then
  begin
    CellText := StringGrid.Cells[ACol, ARow];
    Rect.Inflate(-2, -2);
    if ACol = 0 then
      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_WORDBREAK or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS)
    else
      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_BOTTOM or DT_END_ELLIPSIS);
  end
  else begin
    CellText := StringGrid.Cells[ACol, ARow];
    Rect.Inflate(-2, -2);
    case ACol of
      0..1, 4, 7: begin
        DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
      end;
      2..3, 5..6, 8..9: begin
        DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_RIGHT or DT_VCENTER or DT_END_ELLIPSIS);
      end;
    end;
  end;
end;

end.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 371
  ClientWidth = 606
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object StringGrid: TStringGrid
    Left = 0
    Top = 0
    Width = 606
    Height = 371
    Align = alClient
    ColCount = 1
    FixedCols = 0
    RowCount = 1
    FixedRows = 0
    Options = [goRangeSelect, goRowSelect]
    TabOrder = 0
    OnDrawCell = StringGridDrawCell
  end
end

【讨论】：

【解决方案2】：

主要问题是下面这段使用clWebLinen颜色绘制单元格背景的代码总是在合并单元格的代码之后运行。

if (ACol in [1,2,3,7,8,9])
  then begin
        StringGrid.Canvas.Brush.Color := clWebLinen;
        StringGrid.Canvas.FillRect(Rect);
       end;

不在要合并的单元格上运行此代码，同时为合并中的每个单元格运行合并代码（例如 1、2、3。不仅仅是 1）修复了大多数问题。

最后一步是将合并单元格中的文本居中，这可以通过将DT_LEFT更改为DT_CENTER来实现。

DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);

以下是完整的解决方案。

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const
  cGridLineWidth = 1;
  cGroupCount = 3;
var
  CellText: String;    
  ProdCol: Integer;
  CountCol: Integer;
  WeightCol: Integer;
  Found: Boolean;
begin
  if ((ARow = 0) and (ACol > 0))
    then begin
          ProdCol := 1;
          CountCol := 2;
          WeightCol := 3;
          Found := False;
          while (not Found) do
            begin
              if ((ACol = ProdCol) or (ACol = CountCol) or (ACol = WeightCol))
                then begin
                      Found := True;
                      if (ACol = ProdCol)
                        then begin
                              Rect.Right := Rect.Right + StringGrid.ColWidths[CountCol] + cGridLineWidth + StringGrid.ColWidths[WeightCol] + cGridLineWidth;
                             end
                      else if (ACol = CountCol)
                        then begin
                              Rect.Right := Rect.Right + StringGrid.ColWidths[WeightCol] + cGridLineWidth;
                              Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[ProdCol];
                             end
                        else begin
                              Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[CountCol] - cGridLineWidth - StringGrid.ColWidths[ProdCol];
                             end;
                      CellText := StringGrid.Cells[ProdCol, ARow];
                      if (ACol in [1,2,3,7,8,9])
                        then StringGrid.Canvas.Brush.Color := clWebLinen
                        else StringGrid.Canvas.Brush.Color := clWindow;
                      StringGrid.Canvas.Brush.Style := bsSolid;
                      StringGrid.Canvas.Pen.Style := psClear;
                      StringGrid.Canvas.FillRect(rect);
                      StringGrid.Canvas.Pen.Style := psSolid;
                      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
                     end;
              ProdCol := ProdCol + cGroupCount;
              CountCol := CountCol + cGroupCount;
              WeightCol := WeightCol + cGroupCount;
            end;
         end
    else begin
          CellText := StringGrid.Cells[ACol, ARow];
          if (ACol in [1,2,3,7,8,9])
            then StringGrid.Canvas.Brush.Color := clWebLinen
            else StringGrid.Canvas.Brush.Color := clWindow;
          if (ARow = 0)
            then Exit;
          StringGrid.Canvas.FillRect(Rect);
          DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
         end;
end;

【讨论】：

【解决方案3】：

还有其他可以合并单元格的 StringGrid 组件。比如我自己写的this one（下载源：NLDStringGrid），结果可能是这样的：

var
  R: TRect;
begin
  NLDStringGrid1.Columns.Add;
  NLDStringGrid1.Columns.Add;
  NLDStringGrid1.Cells[1, 1] := 'Sample test'#13#10'Second line';
  NLDStringGrid1.Columns[1].MultiLine := True;
  NLDStringGrid1.AutoRowHeights := True;
  SetRect(R, 2, 2, 3, 3);
  NLDStringGrid1.MergeCells(TGridRect(R), True, True);
  NLDStringGrid1.ColWidths[2] := 40;
  NLDStringGrid1.Cells[2, 2] := 'Sample test'#13#10'Second line';
end;

【讨论】：