StringGrid, Dibujar mas de una celda o columna

[olbeup]

Hola Compañer@s,

Conseguido,

Me ha costado pero lo he conseguido, si alguien le interesa:

Código Delphi [-]
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  objSG: TGridCell;
  SndSG: TStringGrid;
  RectDraw, RectText: TRect;
begin
  SndSG := (Sender as TStringGrid);

  RectDraw := Rect;
    InflateRect(RectDraw, -1, -1);

  RectText := RectDraw;
    InflateRect(RectText, -1, -1);

  objSG := (SndSG.Objects[ACol, ARow] as TGridCell);

  if (not Assigned(objSG)) then
    Exit;

  case objSG.Alignment of
    taLeftJustify:
      Inc(RectText.Left, 2);
    taRightJustify:
      Dec(RectText.Right, 2);
  end;

  with SndSG do
  begin
    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion <= 0) then
      Exit;

    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion > 1) then
    begin
      RectDraw.Right := (RectDraw.Right + objSG.CoordCell.ColUnion -1) + (objSG.CoordCell.DefaultColWidth * (objSG.CoordCell.ColUnion -1));
      RectText.Right := RectDraw.Right;
    end;

    Options := Options - [goRowSelect];
    if (gdSelected in State) and (gdFocused in State) then
      if (objSG.CoordCell.ColUnion > 1) then
      begin
        Options := Options + [goRowSelect];
        Exit;
      end;

    if (gdSelected in State) then
      Canvas.RoundRect(RectDraw.Left, RectDraw.Top, RectDraw.Right, RectDraw.Bottom, 5, 5)
    else
      Canvas.FillRect(RectDraw);

    DrawText(Canvas.Handle, PChar(objSG.TextCell), StrLen(PChar(objSG.TextCell)), RectText, objSG.DrawAlign OR DT_VCENTER OR DT_SINGLELINE);
  end;
end;

Un saludo.