Выравнивание колонок StringGrid 5

{
Код компонента для Delphi на основе стандартного TStringGrid.

Компонет позволяет переносить текст в TStringGrid.

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

Далее были внесены изменения в исходный код, а именно добавлены методы вывода
текста:
1. atLeft - Вывод текста по левой границе;
2. atCenter - Вывод текста по центру ячейки (по горизонтали);
3. atRight - Вывод текста по правой границе;
4. atWrapTop - Вывод и перенос текста по словам относительно верхней границы
ячейки;
5. atWrapCenter - Вывод и перенос текста по словам относительно центра ячейки
(по вертикали);
6. atWrapBottom - Вывод и перенос текста по словам относительно нижней границы
ячейки;

Вносил изменения и тестировал в Delphi 3/4/5:
Автор Pavel Stont.
E-mail: pavel_stont@mail.ru.
Никаких ограничений на использование, распростанение и улучшение кода не налогаются.
Буду очень признателен, если о всех замеченных неполадках сообщите по e-mail.

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

Успехов!

Несколько дополнительных замечаний по коду:
1. Методы Create и DrawCell были перекрыты.
2. Введены два новых свойства, а именно AlignText и AlignCaption соответсвенно методы
выравнивания текста в ячейках данных (обычно - белого цвета) и в фиксированных ячейках
(обычно - серого цвета).
3. Свойство Center - центрация текста по горизонтали независимо от метода.
}

unit NewStringGrid;

interface

uses

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

type

  TAlignText = (atLeft, atCenter, atRight, atWrapTop, atWrapCenter,
    atWrapBottom);

type

  TNewStringGrid = class(TStringGrid)
  private
    { Private declarations }
    FAlignText: TAlignText;
    FAlignCaption: TAlignText;
    FCenter: Boolean;
    procedure SetAlignText(Value: TAlignText);
    procedure SetAlignCaption(Value: TAlignText);
    procedure SetCenter(Value: Boolean);
  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property AlignText: TAlignText read FAlignText write SetAlignText;
    property AlignCaption: TAlignText read FAlignCaption write SetAlignCaption;
    property Center: Boolean read FCenter write SetCenter;
  end;

procedure Register;

implementation

procedure Register;
begin

  RegisterComponents('Other', [TNewStringGrid]);
end;

{ TNewStringGrid }

constructor TNewStringGrid.Create(AOwner: TComponent);
begin

  { Создаем TStringGrid }
  inherited Create(AOwner);
  { Задаем начальные параметры компонента }
  AlignText := atLeft;
  AlignCaption := atCenter;
  Center := False;
  DefaultColWidth := 80;
  DefaultRowHeight := 18;
  Height := 100;
  Width := 408;
  { Заставляем компонент перерисовываться нашей процедурой
  по умолчанию DrawCell }
  DefaultDrawing := FALSE;
end;

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

procedure TNewStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;

  AState: TGridDrawState);
var

  CountI, { Счетчик }
  CountWord: Integer; { Счетчик }
  Sentence, { Выводимый текст }
  CurWord: string; { Текущее выводимое слово }
  SpacePos, { Позиция первого пробела }
  CurXDef, { X-координата 'курсора' по умолчанию }
  CurYDef, { Y-координата 'курсора' по умолчанию }
  CurX, { Х-координата 'курсора' }
  CurY: Integer; { Y-координата 'курсора' }
  EndOfSentence: Boolean; { Величина, указывающая на заполненность ячейки }
  Alig: TAlignText; { Тип выравнивания текста }
  ColPen: TColor; { Цвет карандаша по умолчанию }
  MassWord: array[0..255] of string;
  MassCurX, MassCurY: array[0..255] of Integer;
  LengthText: Integer; { Длина текущей строки }
  MassCurYDef: Integer;
  MeanCurY: Integer;

  procedure VisualCanvas;
  begin
    { Прорисовываем ячейку и придаем ей 3D-вид }
    with Canvas do
    begin
      { Запоминаем цвет пера для последующего вывода текста }
      ColPen := Pen.Color;
      if gdFixed in AState then
      begin
        Pen.Color := clWhite;
        MoveTo(ARect.Left, ARect.Top);
        LineTo(ARect.Left, ARect.Bottom);
        MoveTo(ARect.Left, ARect.Top);
        LineTo(ARect.Right, ARect.Top);
        Pen.Color := clBlack;
        MoveTo(ARect.Left, ARect.Bottom);
        LineTo(ARect.Right, ARect.Bottom);
        MoveTo(ARect.Right, ARect.Top);
        LineTo(ARect.Right, ARect.Bottom);
      end;
      { Восстанавливаем цвет пера }
      Pen.Color := ColPen;
    end;
  end;

  procedure VisualBox;
  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;
  end;

  procedure VisualText(Alig: TAlignText);
  begin
    case Alig of
      atLeft:
        begin
          with Canvas do
            { выводим текст }
            TextOut(CurX, CurY, Sentence);
          VisualCanvas;
        end;
      atRight:
        begin
          with Canvas do
            { выводим текст }
            TextOut(ARect.Right - TextWidth(Sentence) - 2, CurY, Sentence);
          VisualCanvas;
        end;
      atCenter:
        begin
          with Canvas do
            { выводим текст }
            TextOut(ARect.Left + ((ARect.Right - ARect.Left -
              TextWidth(Sentence)) div 2), CurY, Sentence);
          VisualCanvas;
        end;
      atWrapTop:
        begin
          { для каждого слова ячейки }
          EndOfSentence := FALSE;
          CountI := 0;
          while CountI <= SpacePos do
          begin
            MassWord[CountI] := '';
            CountI := CountI + 1;
          end;
          CountI := 0;
          CountWord := CurY;
          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
              { если текст выходит за границы ячейки }
              LengthText := TextWidth(CurWord) + CurX + 2;
              if LengthText > ARect.Right then
              begin
                { переносим на следующую строку }
                CurY := CurY + TextHeight(CurWord);
                CurX := CurXDef + 2;
              end;
              if CountWord <> CurY then
                CountI := CountI + 1;
              MassWord[CountI] := MassWord[CountI] + CurWord;
              { увеличиваем X-координату курсора }
              CurX := CurX + TextWidth(CurWord);
              CountWord := CurY;
            end;
          end;
          with Canvas do
          begin
            CountWord := 0;
            CurY := CurYDef + 2;
            CurX := CurXDef + 2;
            while CountWord <= CountI do
            begin
              case Center of
                True:
                  begin
                    CurWord := MassWord[CountWord];
                    if Copy(CurWord, Length(CurWord) - 1, 1) = ' ' then
                      MassWord[CountWord] := Copy(CurWord, 0, Length(CurWord) -
                        1);
                    MassCurX[CountWord] := ARect.Left + ((ARect.Right -
                      ARect.Left - TextWidth(MassWord[CountWord])) div 2);
                    MassWord[CountWord] := CurWord;
                  end;
                False: MassCurX[CountWord] := CurX;
              end;
              MassCurY[CountWord] := CurY;
              { выводим слово }
              TextOut(MassCurX[CountWord], MassCurY[CountWord],
                MassWord[CountWord]);
              CurY := CurY + TextHeight(MassWord[CountWord]);
              CountWord := CountWord + 1;
            end;
          end;
          VisualCanvas;
        end;
      atWrapCenter:
        begin
          { для каждого слова ячейки }
          EndOfSentence := FALSE;
          CountI := 0;
          while CountI <= SpacePos do
          begin
            MassWord[CountI] := '';
            CountI := CountI + 1;
          end;
          CountI := 0;
          CountWord := CurY;
          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
              { если текст выходит за границы ячейки }
              LengthText := TextWidth(CurWord) + CurX + 2;
              if LengthText > ARect.Right then
              begin
                { переносим на следующую строку }
                CurY := CurY + TextHeight(CurWord);
                CurX := CurXDef + 2;
              end;
              if CountWord <> CurY then
                CountI := CountI + 1;
              MassWord[CountI] := MassWord[CountI] + CurWord;
              { увеличиваем X-координату курсора }
              CurX := CurX + TextWidth(CurWord);
              CountWord := CurY;
            end;
          end;
          with Canvas do
          begin
            CountWord := 0;
            CurX := CurXDef + 2;
            while CountWord <= CountI do
            begin
              case Center of
                True:
                  begin
                    CurWord := MassWord[CountWord];
                    if Copy(CurWord, Length(CurWord) - 1, 1) = ' ' then
                      MassWord[CountWord] := Copy(CurWord, 0, Length(CurWord) -
                        1);
                    MassCurX[CountWord] := ARect.Left + ((ARect.Right -
                      ARect.Left - TextWidth(MassWord[CountWord])) div 2);
                    MassWord[CountWord] := CurWord;
                  end;
                False: MassCurX[CountWord] := CurX;
              end;
              MassCurY[CountWord] := TextHeight(MassWord[CountWord]);
              CountWord := CountWord + 1;
            end;
            CountWord := 0;
            MassCurYDef := 0;
            while CountWord <= CountI do
            begin
              MassCurYDef := MassCurYDef + MassCurY[CountWord];
              CountWord := CountWord + 1;
            end;
            MassCurYDef := (ARect.Bottom - ARect.Top - MassCurYDef) div 2;
            CountWord := 0;
            MeanCurY := 0;
            while CountWord <= CountI do
            begin
              MassCurY[CountWord] := ARect.Top + MeanCurY + MassCurYDef;
              MeanCurY := MeanCurY + TextHeight(MassWord[CountWord]);
              CountWord := CountWord + 1;
            end;
            CountWord := -1;
            while CountWord <= CountI do
            begin
              CountWord := CountWord + 1;
              if MassCurY[CountWord] < (ARect.Top + 2) then
                Continue;
              { выводим слово }
              TextOut(MassCurX[CountWord], MassCurY[CountWord],
                MassWord[CountWord]);
            end;
          end;
          VisualCanvas;
        end;
      atWrapBottom:
        begin
          { для каждого слова ячейки }
          EndOfSentence := FALSE;
          CountI := 0;
          while CountI <= SpacePos do
          begin
            MassWord[CountI] := '';
            CountI := CountI + 1;
          end;
          CountI := 0;
          CountWord := CurY;
          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
              { если текст выходит за границы ячейки }
              LengthText := TextWidth(CurWord) + CurX + 2;
              if LengthText > ARect.Right then
              begin
                { переносим на следующую строку }
                CurY := CurY + TextHeight(CurWord);
                CurX := CurXDef + 2;
              end;
              if CountWord <> CurY then
                CountI := CountI + 1;
              MassWord[CountI] := MassWord[CountI] + CurWord;
              { увеличиваем X-координату курсора }
              CurX := CurX + TextWidth(CurWord);
              CountWord := CurY;
            end;
          end;
          with Canvas do
          begin
            CountWord := 0;
            CurX := CurXDef + 2;
            while CountWord <= CountI do
            begin
              case Center of
                True:
                  begin
                    CurWord := MassWord[CountWord];
                    if Copy(CurWord, Length(CurWord) - 1, 1) = ' ' then
                      MassWord[CountWord] := Copy(CurWord, 0, Length(CurWord) -
                        1);
                    MassCurX[CountWord] := ARect.Left + ((ARect.Right -
                      ARect.Left - TextWidth(MassWord[CountWord])) div 2);
                    MassWord[CountWord] := CurWord;
                  end;
                False: MassCurX[CountWord] := CurX;
              end;
              MassCurY[CountWord] := TextHeight(MassWord[CountWord]);
              CountWord := CountWord + 1;
            end;
            CountWord := 0;
            MassCurYDef := 0;
            while CountWord <= CountI do
            begin
              MassCurYDef := MassCurYDef + MassCurY[CountWord];
              CountWord := CountWord + 1;
            end;
            MassCurYDef := ARect.Bottom - MassCurYDef - 2;
            CountWord := 0;
            MeanCurY := -MassCurY[CountWord];
            while CountWord <= CountI do
            begin
              MeanCurY := MeanCurY + MassCurY[CountWord];
              MassCurY[CountWord] := MassCurYDef + MeanCurY;
              CountWord := CountWord + 1;
            end;
            CountWord := -1;
            while CountWord <= CountI do
            begin
              CountWord := CountWord + 1;
              if MassCurY[CountWord] < (ARect.Top + 2) then
                Continue;
              { выводим слово }
              TextOut(MassCurX[CountWord], MassCurY[CountWord],
                MassWord[CountWord]);
            end;
          end;
          VisualCanvas;
        end;
    end;
  end;

begin

  VisualBox;
  VisualCanvas;
  { Начинаем рисование с верхнего левого угла ячейки }

  CurXDef := ARect.Left;
  CurYDef := ARect.Top;
  CurX := CurXDef + 2;
  CurY := CurYDef + 2;
  { Здесь мы получаем содержание ячейки }

  Sentence := Cells[ACol, ARow];
  { Если ячейка пуста выходим из процедуры }

  if Sentence = '' then
    Exit;
  { Проверяем длину строки (не более 256 символов) }

  if Length(Sentence) > 256 then
  begin
    MessageBox(0, 'Число символов не должно быть более 256.',
      'Ошибка в таблице', mb_OK);
    Cells[ACol, ARow] := '';
    Exit;
  end;
  { Узнаем сколько в предложении слов и задаем размерность массивов }

  SpacePos := Pos(' ', Sentence);
  { Узнаем тип выравнивания текста }

  if gdFixed in AState then
    Alig := AlignCaption
  else
    Alig := AlignText;
  VisualText(Alig);
end;

procedure TNewStringGrid.SetAlignCaption(Value: TAlignText);
begin
  if Value <> FAlignCaption then
    FAlignCaption := Value;
end;

procedure TNewStringGrid.SetAlignText(Value: TAlignText);
begin
  if Value <> FAlignText then
    FAlignText := Value;
end;

procedure TNewStringGrid.SetCenter(Value: Boolean);
begin
  if Value <> FCenter then
    FCenter := Value;
end;

end.