Выравнивание колонок StringGrid
Falk0ner, вс, 06/07/2008 - 15:34.
Выравнивание колонок StringGrid Автор: Kurt
Организуйте обработчик события сетки OnDrawCell. Создайте код обработчика подобный этому:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var
Txt: array[0..255] of Char;
begin
StrPCopy(Txt, StringGrid1.Cells[Col, Row]);
SetTextAlign(StringGrid1.Canvas.Handle,
GetTextAlign(StringGrid1.Canvas.Handle)
and not (TA_LEFT or TA_CENTER) or TA_RIGHT);
ExtTextOut(StringGrid1.Canvas.Handle, Rect.Right - 2, Rect. + 2,
ETO_CLIPPED or ETO_OPAQUE, @Rect, Txt, StrLen(Txt), nil);
end;
Rect: TRect; State: TGridDrawState);
var
Txt: array[0..255] of Char;
begin
StrPCopy(Txt, StringGrid1.Cells[Col, Row]);
SetTextAlign(StringGrid1.Canvas.Handle,
GetTextAlign(StringGrid1.Canvas.Handle)
and not (TA_LEFT or TA_CENTER) or TA_RIGHT);
ExtTextOut(StringGrid1.Canvas.Handle, Rect.Right - 2, Rect. + 2,
ETO_CLIPPED or ETO_OPAQUE, @Rect, Txt, StrLen(Txt), nil);
end;
http://delphiworld.narod.ru/ DelphiWorld 6.0
Нижеприведенный код выравняет данные компонента по правому краю:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row:
Longint; Rect: TRect; State: TGridDrawState);
var
lRow, lCol: Longint;
begin
lRow := Row;
lCol := Col;
with Sender as TStringGrid, Canvas do
begin
if (gdSelected in State) then
begin
Brush.Color := clHighlight;
end
else if (gdFixed in State) then
begin
Brush.Color := FixedColor;
end
else
begin
Brush.Color := Color;
end;
FillRect(Rect);
SetBkMode(Handle, TRANSPARENT);
SetTextAlign(Handle, TA_RIGHT);
TextOut(Rect.Right - 2, Rect. + 2, Cells[lCol, lRow]);
end;
end;
Longint; Rect: TRect; State: TGridDrawState);
var
lRow, lCol: Longint;
begin
lRow := Row;
lCol := Col;
with Sender as TStringGrid, Canvas do
begin
if (gdSelected in State) then
begin
Brush.Color := clHighlight;
end
else if (gdFixed in State) then
begin
Brush.Color := FixedColor;
end
else
begin
Brush.Color := Color;
end;
FillRect(Rect);
SetBkMode(Handle, TRANSPARENT);
SetTextAlign(Handle, TA_RIGHT);
TextOut(Rect.Right - 2, Rect. + 2, Cells[lCol, lRow]);
end;
end;
Хитрость заключается в установке выравнивания текста TA_RIGHT, позволяющей осуществлять вывод текста, начиная с правой стороны (от правой границы). Не бойтесь, текст не будет напечатан задом наперед!
Вы наверное уже обратили внимание на объявление локальных переменных lCol и lRow. На входе я присваиваю им значения параметров Col и Row (имя, которое дало мне Delphi IDE). Дело в том, что объект TStringGrid имеет свойства с именами Col и Row. Эти свойства будут доступны в теле блока "with Sender as TStringGrid", но они не являются параметрами для всех обявленных в шапке блока объектов ((речь идет об объекте Canvas, у которого нет свойств с именами Col и Row - В.О.)).
http://delphiworld.narod.ru/ DelphiWorld 6.0
procedure WriteText(ACanvas: TCanvas; const ARect: TRect; DX, DY: Integer;
const Text: string; Format: Word);
var
S: array[0..255] of Char;
B, R: TRect;
begin
with ACanvas, ARect do
begin
case Format of
DT_LEFT: ExtTextOut(Handle, Left + DX, + DY, ETO_OPAQUE or
ETO_CLIPPED,
@ARect, StrPCopy(S, Text), Length(Text), nil);
DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, + DY,
ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
Length(Text), nil);
DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div
2,
+ DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
StrPCopy(S, Text), Length(Text), nil);
end;
end;
end;
procedure TBEFStringGrid.DrawCell(Col, Row: Longint; Rect: TRect; State:
TGridDrawState);
var
procedure Display(const S: string; Alignment: TAlignment);
const
Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
WriteText(Canvas, Rect, 2, 2, S, Formats[Alignment]);
end;
begin
{ здесь задаем аргументы Col и Row, и форматируем как угодно ячейки }
case Row of
0: { Центрирование заголовков колонок }
if (Col < ColCount) then
Display(Cells[Col, Row], taCenter)
else
{ Все другие данные имеют правое центрирование }
Display(Cells[Col, Row], taRight);
end;
end;
const Text: string; Format: Word);
var
S: array[0..255] of Char;
B, R: TRect;
begin
with ACanvas, ARect do
begin
case Format of
DT_LEFT: ExtTextOut(Handle, Left + DX, + DY, ETO_OPAQUE or
ETO_CLIPPED,
@ARect, StrPCopy(S, Text), Length(Text), nil);
DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, + DY,
ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
Length(Text), nil);
DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div
2,
+ DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
StrPCopy(S, Text), Length(Text), nil);
end;
end;
end;
procedure TBEFStringGrid.DrawCell(Col, Row: Longint; Rect: TRect; State:
TGridDrawState);
var
procedure Display(const S: string; Alignment: TAlignment);
const
Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
WriteText(Canvas, Rect, 2, 2, S, Formats[Alignment]);
end;
begin
{ здесь задаем аргументы Col и Row, и форматируем как угодно ячейки }
case Row of
0: { Центрирование заголовков колонок }
if (Col < ColCount) then
Display(Cells[Col, Row], taCenter)
else
{ Все другие данные имеют правое центрирование }
Display(Cells[Col, Row], taRight);
end;
end;
http://delphiworld.narod.ru/ DelphiWorld 6.0
Создайте ваш собственный метод drawcell на примере того, что приведен ниже:
procedure Tsearchfrm.Grid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var
l_oldalign: word;
begin
if (row = 0) or (col < 2) then
{устанавливаем заголовок в жирном начертании}
grid1.canvas.font.style := grid1.canvas.font.style + [fsbold];
if col <> 1 then
begin
l_oldalign := settextalign(grid1.canvas.handle, ta_right);
{NB использует для рисования правую сторону квадрата}
grid1.canvas.textrect(rect, rect.right - 2, Rect.top + 2, grid1.cells[col,
row]);
settextalign(grid1.canvas.handle, l_oldalign);
end
else
begin
grid1.canvas.textrect(rect, rect.left + 2, rect.top + 2, grid1.cells[col,
row]);
end;
grid1.canvas.font.style := grid1.canvas.font.style - [fsbold];
end;
Rect: TRect; State: TGridDrawState);
var
l_oldalign: word;
begin
if (row = 0) or (col < 2) then
{устанавливаем заголовок в жирном начертании}
grid1.canvas.font.style := grid1.canvas.font.style + [fsbold];
if col <> 1 then
begin
l_oldalign := settextalign(grid1.canvas.handle, ta_right);
{NB использует для рисования правую сторону квадрата}
grid1.canvas.textrect(rect, rect.right - 2, Rect.top + 2, grid1.cells[col,
row]);
settextalign(grid1.canvas.handle, l_oldalign);
end
else
begin
grid1.canvas.textrect(rect, rect.left + 2, rect.top + 2, grid1.cells[col,
row]);
end;
grid1.canvas.font.style := grid1.canvas.font.style - [fsbold];
end;
http://delphiworld.narod.ru/ DelphiWorld 6.0
Автор: 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. atWrap - Вывод и перенос текста по словам относительно верхней границы
ячейки;
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, atWrap, 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.);
LineTo(ARect.Left, ARect.Bottom);
MoveTo(ARect.Left, ARect.);
LineTo(ARect.Right, ARect.);
Pen.Color := clBlack;
MoveTo(ARect.Left, ARect.Bottom);
LineTo(ARect.Right, ARect.Bottom);
MoveTo(ARect.Right, ARect.);
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., 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;
atWrap:
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. - MassCurYDef) div 2;
CountWord := 0;
MeanCurY := 0;
while CountWord <= CountI do
begin
MassCurY[CountWord] := ARect. + 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. + 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. + 2) then
Continue;
{ выводим слово }
TextOut(MassCurX[CountWord], MassCurY[CountWord],
MassWord[CountWord]);
end;
end;
VisualCanvas;
end;
end;
end;
begin
VisualBox;
VisualCanvas;
{ Начинаем рисование с верхнего левого угла ячейки }
CurXDef := ARect.Left;
CurYDef := ARect.;
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 на основе стандартного 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. atWrap - Вывод и перенос текста по словам относительно верхней границы
ячейки;
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, atWrap, 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.);
LineTo(ARect.Left, ARect.Bottom);
MoveTo(ARect.Left, ARect.);
LineTo(ARect.Right, ARect.);
Pen.Color := clBlack;
MoveTo(ARect.Left, ARect.Bottom);
LineTo(ARect.Right, ARect.Bottom);
MoveTo(ARect.Right, ARect.);
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., 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;
atWrap:
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. - MassCurYDef) div 2;
CountWord := 0;
MeanCurY := 0;
while CountWord <= CountI do
begin
MassCurY[CountWord] := ARect. + 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. + 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. + 2) then
Continue;
{ выводим слово }
TextOut(MassCurX[CountWord], MassCurY[CountWord],
MassWord[CountWord]);
end;
end;
VisualCanvas;
end;
end;
end;
begin
VisualBox;
VisualCanvas;
{ Начинаем рисование с верхнего левого угла ячейки }
CurXDef := ARect.Left;
CurYDef := ARect.;
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.
http://delphiworld.narod.ru/ DelphiWorld 6.0
Отправить комментарий