TStringGrid merge cell drawing

delphi delphi-2006 tstringgrid
Jason Fowler picture Jason Fowler · Nov 5, 2014 · Viewed 11.2k times · Source

This link/pic shows what I am trying to achieve with a TStringGrid.

enter image description here

This link/pic show what my code below is resulting in.

enter image description here

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.

And this is my unit1.dfm file contents.

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

The problem seems to be with the merging code in StringGridDrawCell just below the //Attempt to merge 3 cells into one comment.

I'm sure it's probably something obvious, but for the life of me I can't see it.

NOTE: If someone could turn the links into embedded images that would be much appreciated as I don't seem to have enough reputation to post images.

Answer

Remy Lebeau picture Remy Lebeau · Nov 6, 2014

Try this:

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

grid

Related questions

Firebird error "username and password are not defined" with Delphi application

I have an application made with Delphi 2006 and Firebird 2.5. For connection a use Interbase components from Delphi. I setting up in design time a TIBDatabase with username, password tc, and work ok, but when i want to run application in …

Read More
Delphi 2006-2010 error: "Cannot create file C:\Users\Admin\AppData\Local\Temp\EditorLineEnds.ttr"

I am getting an error after installing Delphi 2007 (Edit: This problem occurs in all Delphi versions from 2006 to 2010) that I can not figure out and have never seen before. After restarting I can launch the program without any problems, but …

Read More
Delphi code formatter

Are there any utilities that reformat Delphi code ? EDIT I am using Delphi 2006 Some feedback Thanks to all that answered this question I have been using the JCF code formatter - it works well and my code is been formated …

Read More