Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Выравнивание колонок TStringGrid

01.01.2007
Автор: 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.Top + 2,
    ETO_CLIPPED or ETO_OPAQUE, @Rect, Txt, StrLen(Txt), nil);
end;

https://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.Top + 2, Cells[lCol, lRow]);
  end;
end;

Хитрость заключается в установке выравнивания текста TA_RIGHT, позволяющей осуществлять вывод текста, начиная с правой стороны (от правой границы). Не бойтесь, текст не будет напечатан задом наперед!

Вы наверное уже обратили внимание на объявление локальных переменных lCol и lRow. На входе я присваиваю им значения параметров Col и Row (имя, которое дало мне Delphi IDE). Дело в том, что объект TStringGrid имеет свойства с именами Col и Row. Эти свойства будут доступны в теле блока "with Sender as TStringGrid", но они не являются параметрами для всех обявленных в шапке блока объектов ((речь идет об объекте Canvas, у которого нет свойств с именами Col и Row - В.О.)).

https://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, Top + DY, ETO_OPAQUE or
        ETO_CLIPPED,
          @ARect, StrPCopy(S, Text), Length(Text), nil);
 
      DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
          ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
          Length(Text), nil);
 
      DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div
        2,
          Top + 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;
 
 

https://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; 

https://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. 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.
 
 
 
 

https://delphiworld.narod.ru/

DelphiWorld 6.0