Delphi World - Выравнивание колонок StringGrid 5
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Выравнивание колонок StringGrid 5

Автор: Pavel Stont


{
Код компонента для 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования