Многострочность

Code:

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

Позволяет переносить текст в TStringGrid, отсюда и его имя - TWrapGrid.

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

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

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

Для использования:  Выберите в Delphi пункты меню 'Options' - 'Install Components'.

Нажмите 'Add'.

Найдите и выберите файл с именем 'Wrapgrid.PAS'.

Нажмите 'OK'.

После этого вы увидете компонент во вкладке "Samples" палитры компонентов

Delphi.

После этого вы можете использовать компонент вместо стандартного TStringGrid.

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

Успехов!

Несколько дополнительных замечаний по коду:

Методы 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.