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