Размеры колонок и строк, выравнивание

Code:

{

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

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

В качестве исходного текста был использован компонент TWrapGrid.

Автор Luis J. de la Rosa.

E-mail: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Вы свободны в использовании, распространении и улучшении кода.

Пожалуйста шлите любые комментарии и пожелания на адрес Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра..

Далее были внесены изменения в исходный код, а именно добавлены методы вывода

текста:

1. atLeft - Вывод текста по левой границе;

2. atCenter - Вывод текста по центру ячейки (по горизонтали);

3. atRight - Вывод текста по правой границе;

4. atWrapTop - Вывод и перенос текста по словам относительно верхней границы

ячейки;

5. atWrapCenter - Вывод и перенос текста по словам относительно центра ячейки

(по вертикали);

6. atWrapBottom - Вывод и перенос текста по словам относительно нижней границы

ячейки;

Вносил изменения и тестировал в Delphi 3/4/5:

Автор Pavel Stont.

E-mail: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра..

Никаких ограничений на использование, распростанение и улучшение кода не налогаются.

Буду очень признателен, если о всех замеченных неполадках сообщите по 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.