Компонет TWrapGrid, осуществляющий перенос текста в TStringGrid

{  Код заказного компонента для Delphi.

Позволяет переносить текст в TStringGrid, отсюда и его имя - TWrapGrid.
Автор Luis J. de la Rosa.
E-mail: delarosa@ix.netcom.com
Вы свободны в использовании, распространении и улучшении кода.

Для использования:  Выберите в Delphi пункты меню 'Options' - 'Install Components'.
Нажмите 'Add'.
Найдите и выберите файл с именем 'Wrapgrid.PAS'.
Нажмите 'OK'.
После этого вы увидете компонент во вкладке "Samples" палитры компонентов
Delphi.
После этого вы можете использовать компонент вместо стандартного TStringGrid.

Пожалуйста шлите любые комментарии и пожелания на адрес delarosa@ix.netcom.com.
Успехов!

Несколько дополнительных замечаний по коду:
Методы Create и DrawCell были перекрыты. Everything else should
behave just like a TStringGrid.
The Create sets the DefaultDrawing to False, so you don't need to.

Also, I am using the pure block emulation style of programming, making my
code easier to read.
}

unit Wrapgrid;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids;

type

  TWrapGrid = class(TStringGrid)
  private
    { Private declarations }
  protected
    { Protected declarations }
    { Процедура DrawCell осуществляет перенос текста в ячейке }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    { Public declarations }
    { Процедура Create перекрывается для того, чтобы использовать процедуру DrawCell
    по умолчанию }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

constructor TWrapGrid.Create(AOwner: TComponent);
begin

  { Создаем TStringGrid }
  inherited Create(AOwner);

  { Заставляем компонент перерисовываться нашей процедурой по умолчанию DrawCell }
  DefaultDrawing := FALSE;
end;

{ Процедура DrawCell осуществляет перенос текста в ячейке }

procedure TWrapGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;

  AState: TGridDrawState);
var

  Sentence, { Выводимый текст }
  CurWord: string; { Текущее выводимое слово }
  SpacePos, { Позиция первого пробела }
  CurX, { Х-координата 'курсора' }
  CurY: Integer; { Y-координата 'курсора' }
  EndOfSentence: Boolean; { Величина, указывающая на заполненность ячейки }
begin

  { Инициализируем шрифт, чтобы он был управляющим шрифтом }
  Canvas.Font := Font;

  with Canvas do
  begin
    { Если это фиксированная ячейка, тогда используем фиксированный цвет }
    if gdFixed in AState then
    begin
      Pen.Color := FixedColor;
      Brush.Color := FixedColor;
    end
      { в противном случае используем нормальный цвет }
    else
    begin
      Pen.Color := Color;
      Brush.Color := Color;
    end;

    { Рисуем подложку цветом ячейки }
    Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  end;

  { Начинаем рисование с верхнего левого угла ячейки }
  CurX := ARect.Left;
  CurY := ARect.Top;

  { Здесь мы получаем содержание ячейки }
  Sentence := Cells[ACol, ARow];

  { для каждого слова ячейки }
  EndOfSentence := FALSE;
  while (not EndOfSentence) do
  begin
    { для получения следующего слова ищем пробел }
    SpacePos := Pos(' ', Sentence);
    if SpacePos > 0 then
    begin
      { получаем текущее слово плюс пробел }
      CurWord := Copy(Sentence, 0, SpacePos);

      { получаем остальную часть предложения }
      Sentence := Copy(Sentence, SpacePos + 1, Length(Sentence) - SpacePos);
    end
    else
    begin
      { это - последнее слово в предложении }
      EndOfSentence := TRUE;
      CurWord := Sentence;
    end;

    with Canvas do
    begin
      { если текст выходит за границы ячейки }
      if (TextWidth(CurWord) + CurX) > ARect.Right then
      begin
        { переносим на следующую строку }
        CurY := CurY + TextHeight(CurWord);
        CurX := ARect.Left;
      end;

      { выводим слово }
      TextOut(CurX, CurY, CurWord);
      { увеличиваем X-координату курсора }
      CurX := CurX + TextWidth(CurWord);
    end;
  end;
end;

procedure Register;
begin

  { Вы можете изменить закладку Samples на любую другую
  палитре компонентов Delphi }
  RegisterComponents('Samples', [TWrapGrid]);
end;

end.