Версия для печати


НеОбычный TDBGrid
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=806

Елена Филиппова
Игорь Шевченко
дата публикации 10-06-2003 18:02

НеОбычный TDBGrid Содержание
  1. Многострочные заголовки
  2. Компонент в ячейке редактирования
  3. Синхронизация гридов
  4. Сложные заголовки
  5. Имитация внутренних группировок и метки колонок

Материал рассчитан на начинающих программистов, которые хотят научиться не только использовать чужие компоненты, но и писать свои. Авторы ни в коем случае не отрицают положительные стороны использования сторонних компонентов, более того, нередко сами их используют. Тем не менее, придерживаются четкого мнения, что если хочешь контролировать ситуацию — нужно знать "как оно там все работает". Обычный TDBGrid можно превратить в мощный инструмент своими руками, заточив его под определенные задачи. Именно этому и посвящена наша статья.

Итак, создаем из стандартного компонента необычный грид :о)

Многострочные заголовки

1.Рисование многострочных заголовков с использованием стандартного компонента TDBGrid.

[ К содержанию ]

При использовании стандартного компонента TDBGrid для рисования доступна только область данных колонок, изначально не включающая в себя фиксированные области TDBGrid, рисующиеся самим компонентом. Зная тот факт, что при событиях рисования доступна вся клиентская область окна, можно попробовать обмануть компонент и рисовать в другой области, чем та, которая передается процедуре рисования. Так как событие OnDrawCell вызывается для каждой ячейки Grid'а, а заголовки желательно рисовать один раз, заводим массив признаков нарисованных заголовков:

  GridTitles : : array of Boolean;
Обработчик события OnDrawColumnCell выглядит достаточно просто: 

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if not GridTitles[Column.Index] then
    DrawGridTitle(Column.Index);
end;

Если заголовок колонки не нарисован, то нарисовать его. Процедура рисования должна определить координаты области заголовка и ее размеры и заново перерисовать эту область. Сама процедура оформлена как локальная, для того, чтобы не передавать параметры, переданные обработчику события. Для простоты заголовок делается двухстрочным, но ничего не мешает рисовать произвольное количество строк. RowCount объявлено константой и равно 2.

procedure DrawGridTitle(ColIndex : Integer);
  var
      Titles : array[1..RowCount] of String;
      ARect : TRect; { Собственно область заголовка }
      RH : Integer;  { Высота области заголовка }
      BlankPos : Integer; { Позиция разбиения заголовка }
  begin
    BlankPos := Pos(' ', Column.Title.Caption);
    if BlankPos <> 0 then begin { Рисуем многострочный заголовок только для тех
                                  колонок, у которых есть пробел в названии.
                                  Заголовки остальных колонки DBGrid
                                  нарисует сам. }
      Titles[1] := Copy(Column.Title.Caption, 1, BlankPos-1);
      Titles[2] := Copy(Column.Title.Caption, BlankPos+1,
                   Length(Column.Title.Caption) - BlankPos);
      RH := RectHeight(Rect);
      { В прямоугольнике Rect передаются координаты текущей ячейки,
        область для рисования заголовка можно получить, указывая в качестве
        вертикальной координаты 0. Высота области рисования сейчас
        равна высоте стандартной ячейки DBGrid, как раз на одну строку
        заголовка. }
      SetRect(ARect, Rect.Left, 0, Rect.Right, RH);
      InflateRect(ARect, -2, -2); { Поправка на окантовку Titles }
      Dec(RH, 2); { Смещение для отступа текста от края по вертикали }
      with DBGrid1.Canvas do begin
        Brush.Color := DBGrid1.FixedColor;
        FillRect(ARect); { Залить область заголовка, стерев все, что там
                           нарисовано DBGrid'ом }
        { Рисование первой строки в заголовке }
        ARect.Bottom := RH;
        DrawText(Handle, PChar(Titles[1]), -1, ARect, DT_CENTER or DT_SINGLELINE);
        { Рисование второй строки в заголовке, предварительно сместив
        область рисования вниз на размер строки. }
        OffsetRect(ARect, 0, RH-2);
        DrawText(Handle, PChar(Titles[2]), -1, ARect,DT_CENTER or DT_SINGLELINE);
      end;
    end;
    GridTitles[ColIndex] := true; //Нарисовали заголовок для этой колонки
  end;

Высота любой строки любого наследника TCustomGrid определяется свойством RowHeights[номер строки]. Так как это свойство объявлено protected, для того, чтобы высота области заголовков DBGrid'а была большая, чем стандартная, используется обычный прием доступа к защищенным свойствам компонента, с описанием наследника от требуемого класса и повышением области видимости требуемого свойства:

type
  THackGrid = class(TCustomGrid)
  public
    property RowHeights;
  end;
Высоту области надо задать один раз, что и делается в обработчике события FormShow 

procedure TForm1.FormShow(Sender: TObject);
var
  ....
  H : Integer;
  { Определение необходимой высоты строки для многострочных заголовков }
  H := DbGrid1.Canvas.TextHeight('gW');
  THackGrid(DBGrid1).RowHeights[0] := (H + 2) * RowCount; { RowCount
  принудительно объявлено 2 }
end;

Результат работы:

рис. 1

После первого запуска программы обнаружен интересный эффект - при переключении на другое окно и обратном переключении на окно с Grid'ом многострочность заголовков пропадает. Аналогичным образом она пропадает при перемещении по гриду с помощью вертикального и горизонтального ScrollBar'ов. Для события переключения окна положение можно исправить, указав необходимость перерисовки заголовков в событии FormActivate, со ScrollBar'ами бороться придется подменой оконной процедуры DBGrid'а. Сделаем метод формы, сбрасывающий признаки рисования у всех заголовков:

procedure TForm1.InvalidateGridTitles;
var
  I : Integer;
begin
  for I:=0 to Pred(DBGrid1.Columns.Count) do
    GridTitles[I] := false;
end;

И будем вызывать его каждый раз, когда потребуется полная перерисвока заголовков. 
procedure TForm1.FormActivate(Sender: TObject);
begin
  InvalidateGridTitles();
end;
И в подмененной оконной процедуре DBGrid'а: 

procedure TForm1.GridWndProc(var Message: TMessage);
begin
  case Message.Msg of
  WM_ERASEBKGND, WM_VSCROLL:
    InvalidateGridTitles();
  WM_HSCROLL:
    begin
      InvalidateGridTitles();
      // сожалению, приходится мириться с необходимостью перерисовки всего
      // DBGrid'а при горизонтальном скроллинге, иначе, все усилия по рисованию
      // многострочных заголовков пропадают :-(
      InvalidateRect(GridWnd, nil, true);
    end;
  end;
  with Message do
    Result := CallWindowProc(OldWndProc, GridWnd, Msg, wParam, lParam);
end;

В первом варианте при обработке собщения WM_HSCROLL не был написан код для перерисовки всего окна DBGrid. Как я ни старался, победить ситуацию пропадания многострочных заголовков мне не удалось, поэтому и был добавлен код, принудительно перерисовывающий все окна DBGrid.

2. Рисование многострочных заголовков с использованием наследника компонента TDBGrid.

[ К содержанию ]

В отличие от рисования нестандартных заголовков при использовании стандартного компонента TDBGrid, в наследнике такое рисование выполняется проще, так как в компоненте есть виртуальный метод DrawCell, который вызывается для всех ячеек грида, а не только для содержащих данные. Рисование нестандартных заголовков в этом случае выполняется в перекрытом методе DrawCell в наследнике.

Кроме того, так как метод DrawCell вызывается гридом при любой его перерисовке, затрагивающей клиентскую область окна, нет нужды отслеживать, какие заголовки были нарисованы или обновлять все окно грида при скроллинге. Наше рисование будет вызвано только тогда, когда возникнет реальная необходимость в отрисовке области заголовков грида.

procedure THSDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  State: TGridDrawState);
var
  TitleText : String; { Полный заголовок }
  Titles : array of String; { Части заголовка }

  { Разбиение полного заголовка на части с возвращением числа получившихся
    частей }
  function SplitTitle : Integer;
  const
    TitleSeparator = ' '; { Можно этот символ вынести в published property }
  var
    CurPos, J: Integer;
    CurStr: string;
  begin
    SetLength(Titles, FTitleLines);
    { Определяем, сколько реально строк присутсвует в заголовке. 
      Просто считается количество символов TitleSeparator }
    J := 0;
    CurStr:= TitleText;
    repeat
      CurPos:= Pos(TitleSeparator, CurStr);
      if (CurPos > 0) and (J < Pred(FTitleLines)) then begin
        Titles[J] := Copy(CurStr, 1, Pred(CurPos));
        CurStr:= Copy(CurStr, CurPos+Length(TitleSeparator),
                    Length(CurStr)-CurPos-Length(TitleSeparator)+1);
        Inc(J);
      end else begin
        Titles[J] := CurStr;
        if J >= Pred(FTitleLines) then { Не надо копировать больше, чем может
                                         вместить заголовок }
          Break;
      end;
    until CurPos=0;
    Result := J+1;
  end;

var
  DataCol, I, TitleParts : Integer;
  TextRect : TRect;
  LineHeight : Integer;
begin
  if (dgTitles in Options) AND (gdFixed in State) AND (ARow = 0) AND
     (ACol <> 0) then begin
    { Должна быть нарисована ячейка заголовка }
    { Стандартное действие DBGrid }
    if csLoading in ComponentState then begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(ARect);
      Exit;
    end;
    DataCol := ACol;
    if dgIndicator in Options then
      Dec(DataCol);
    { Изменение размеров области заголовка под окантовку, если хочется сделать
      плоские заголовки, то InflateRect надо пропустить }
    if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
      InflateRect(ARect, -1, -1);
    TitleText := Columns[DataCol].Title.Caption;
    Canvas.Brush.Color := FixedColor;
    { Если захочется сделать прозрачный заголовок, то вызов FillRect надо будет
      пропустить }
    { Если будет желание рисовать фоновую картинку в области заголовка, то
      нарисовать ее можно здесь }
    Canvas.FillRect(ARect);
    { Теперь можно нарисовать собственно текст }
    Canvas.Font := Font;
    if FTitleLines = 1 then begin
      WriteText (Canvas, ARect, 1, 1, TitleText,
                 Columns[DataCol].Title.Alignment);
    end else begin
      TitleParts := SplitTitle();
      TextRect := ARect;
      LineHeight := RectHeight(ARect) DIV TitleParts;
      TextRect.Bottom := TextRect.Top + LineHeight;
      for I:=0 to Pred(TitleParts) do begin
        WriteText (Canvas, TextRect, 1, 0, Titles[I],
                   Columns[DataCol].Title.Alignment);
        OffsetRect(TextRect, 0, LineHeight);
      end;
    end;
    { Окантовка ячейки заголовка, если хочется сделать плоские заголовки,
      то DrawEdge надо пропустить }
    if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then begin
      InflateRect(ARect, 1, 1);
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
    end;
    DoDrawTitleCell (DataCol, Columns[DataCol], ARect);
  end else
    inherited;
end;

Кроме того, появляется возможность вызывать пользовательское событие при рисовании области заголовков, причем после того, как заголовок уже нарисован самим компонентом.

Задание высоты заголовков в наследнике также выполняется проще, так как имеется доступ к защищенным свойствам родительского компонента.

procedure THSDBGrid.CalcTitleHeight;
begin
  if dgTitles in Options then
    RowHeights[0] := (Canvas.TextHeight('gW') + 2) * FTitleLines;
end;

Высоту области заголовка необходимо задавать один раз при создании окна грида и каждый раз, при изменении свойств грида, влияющих на его внешний вид. При создании окна и при изменении свойств грида вызываются виртуальные методы CreateWnd и LayoutChanged, в перекрытые версии которых добавлен вызов процедуры CalcTitleHeight.

Компонент в ячейке редактирования

Отвлечемся на некоторое время от заголовков TDBGrid и обратимся к редактированию данных. Стандартный внутренний редактор ячеек грида (TInplaceEditor) не всегда самый удобный вариант. Можно использовать собственные диалоговые окна для выбора значений и их редактирования, а можно просто встроить нужный компонент в сам грид. Вот этим мы сейчас и займемся.

Подмена стандартного Inplace-Editor'a в DBGrid отдельным компонентом на примере TDBComboBox.

[ К содержанию ]

Для того, чтобы вместо стандартного редактора в колонке DBGrid'а появился другой компонент, проделаем несколько действий:


рис. 2

procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if (gdFocused in State) then
    if (Column.Field.FieldName = FEditor.DataField) then begin
      { Вместо стандартного InplaceEditor'а показываем ComboBox }
      FEditor.Left := Rect.Left + DBGrid.Left;
      FEditor.Top := Rect.Top + DBGrid.top;
      FEditor.Width := Rect.Right - Rect.Left + 2;
      FEditor.Visible := True;
    end;
end;

Для того, чтобы нарисованный компонент не оставался видимым после того, как нужная ячейка потеряет фокус, спрячем его в обработчике события ColExit

procedure TForm1.DBGridColExit(Sender: TObject);
begin
  { При выходе с поля ComboBox надо скрыть }
  if DBGrid.SelectedField.FieldName = FEditor.DataField then
    FEditor.Visible := false;
end;

Для того, чтобы менять значение поля можно было не только выбором мышью из списка, но и с клавиатуры, необходимо передавать ComboBox'у нажатия клавиш DBGrid'а, при редактировании поля. Это можно сделать как в обработчике события OnKeyPress DBGrid'a, так и в обработчике OnKeyDown. Я приведу пример обработчика OnKeyPress.

procedure TForm1.DBGridKeyPress(Sender: TObject; var Key: Char);
begin
{ Передаем все нажатия клавиш в InplaceEditor'е созданному ComboBox'у }
  if (Key <> chr(9)) then
    if (DBGrid.SelectedField.FieldName = FEditor.DataField) then begin
      FEditor.SetFocus;
      SendMessage(FEditor.Handle, WM_CHAR, word(Key), 0);
    end;
end;

В примере использован TDBComboBox, по аналогии с ним можно использовать для редактирования и другие компоненты. Ниже на рисунке показан пример, где аналогичным образом в грид встроен TDBDateEdit для редактирования полей типа "дата":


Синхронизация гридов

Синхронизация размеров и положения колонок двух гридов

[ К содержанию ]

Задача состоит в том, чтобы заставить два TDBGrid, расположенных один под другим, полностью синхронизировать свою работу с колонками: изменение размеров колонок и их перемещение должно происходить в обоих гридах отдновременно. Самое распространенное применение этой задачи в отображении грида с данными и грида с итогами (см. рис. 3). Верхний грид содержит список всех стран с данными по площади и населению(MainGrid), нижний — список, где эти же данные сгруппированы по континентам(TotalGrid).


рис. 3

При синхронизации действий будем считать, что тот грид, который инициирует это действие — ведущий, а второй в этой ситуации — ведомый. Чтобы не зациклить синхронизацию, введем дополнительную переменную: 

SynchProccesed : Boolean;

Для синхронизации необходимо обработать три события: Для отслеживания перемещения колонок воспользуемся событием OnColumnMoved. Синхронизацию проведем незатейливо: полностью перепишем колонки ведомого грида, взяв за основу колонки ведущего: 

//--------------------------------------------------------------------------------------------------
procedure TfExDBG.mainGridColumnMoved(Sender: TObject; FromIndex,
  ToIndex: Integer);
Var Grid   : TDBGrid;
begin
   // TDBGrid(Sender) инициирует перемещение колонок, он — ведущий грид
   // определяем "ведомый" грид
   IF TDBGrid(Sender).Name = 'TotalGrid'  Then Grid:=MainGrid
   Else Grid:=TotalGrid;
				   
   // Сейчас ведомому гриду не нужно реагировать на изменение его колонок, 
   // инициируя в свою очередь синхронизацию с другим гридом
   SynchProccesed:=True;

   Grid.Columns.Assign(TDBGrid(Sender).Columns);
   
   // Синхронизация завершена
   SynchProccesed:=False;

end;
//--------------------------------------------------------------------------------------------------

Для отслеживания горизонтального скролинга как нельзя лучше подходит метод TCustomDBGrid.TopLeftChanged. К сожалению, в стандартном TDBGrid этот метод не доступен (protected). Поэтому, лучшим вариантом будет не мучить стандартный грид, а создать собственного наследника. Положительные стороны этого способа уже описывались в начале статьи.

  TexDBGrid = class(TDBGrid)
  private
    FOnTopLeftChanged : TNotifyEvent;									   
    ...
  public
    Procedure TopLeftChanged; override;
	...
  published
    Property OnTopLeftChanged   : TNotifyEvent     read FOnTopLeftChanged write FOnTopLeftChanged;
	...
  End;	
...
//--------------------------------------------------------------------------------------------------
Procedure TexDBGrid.TopLeftChanged;
Begin
  Inherited;
  IF Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
End;

Теперь нам доступно событие OnTopLeftChanged. Синхронизация заключается в том, чтобы сделать первой видимой колонкой ведомого грида ту же колонку, что и у ведущего. Для этого нам понадобится свойство TCustomGrid.LeftCol (см. help). Это свойство protected, но так как мы создаем собственного наследника от TDBGrid, то повысить его видимость нам не составит труда.

//--------------------------------------------------------------------------------------------------
procedure TfExDBG.GridTopLeftChanged(Sender: TObject);
Var Grid : TexDBGrid;
begin

   IF NOT SynchProccesed Then
   Begin
				
     // TDBGrid(Sender) инициирует скролинг, он — ведущий грид
     // определяем "ведомый" грид      
     IF TDBGrid(Sender).Name = 'TotalGrid'  Then Grid:=MainGrid
     Else Grid:=TotalGrid;

     SynchProccesed:=True;
     Grid.LeftCol:=TexDBGrid(Sender).LeftCol;
     SynchProccesed:=False;
   End;

end;
//--------------------------------------------------------------------------------------------------

И, наконец, третий пункт: отслеживаем изменение ширины колонки. Синхронизация в этом случае будет заключаться только в том, чтобы ширину колонок ведомого грида сделать равной ширине колонок ведущего.

//--------------------------------------------------------------------------------------------------
Procedure TfExDBG.SynchronizeGrids( MasterGrid , SlaveGrid : TDBGrid );
Var i : Integer;
Begin

  IF NOT SynchProccesed Then
  Begin
     SynchProccesed:=True;
     For i:=0 To MasterGrid.Columns.Count - 1 Do
       SlaveGrid.Columns[i].Width:=MasterGrid.Columns[i].Width ;
     SynchProccesed:=False;
  End;

End;
//--------------------------------------------------------------------------------------------------

А вот в какой момент применить этот метод? Ведь у грида нет события OnResizeColumn... Внимательно изучив help, обратим внимание на метод SetColumnAttributes: 
Sets the column widths and disables tabbing to cells that can’t be edited.

procedure SetColumnAttributes; virtual;

Description

Applications cannot call this protected method. It is called automatically when the 
Columns property is recomputed, to adjust the column widths and ensure that 
the user can only tab to fields that can be edited.

Этот метод автоматически вызывается всякий раз, когда изменяются настройки колонок, в том числе их ширина. Мы нашли то, что нам нужно!

По аналогии с OnTopLeftChanged создадим в нашем гриде событие OnSetColumnAttr: 

  TexDBGrid = class(TDBGrid)
  private
    FOnTopLeftChanged,
    FOnSetColumnAttr : TNotifyEvent;									   
    ...									   
  protected
    Procedure SetColumnAttributes; override;	
  public
    Procedure TopLeftChanged; override;
	...
  published
    Property OnTopLeftChanged   : TNotifyEvent  read FOnTopLeftChanged write FOnTopLeftChanged;
    Property OnSetColumnAttr    : TNotifyEvent  read FOnSetColumnAttr  write FOnSetColumnAttr;	
	...
  End;	
...
//--------------------------------------------------------------------------------------------------
procedure TexDBGrid.SetColumnAttributes;
begin
  inherited;
  IF Assigned(FOnSetColumnAttr) Then FOnSetColumnAttr(Self);
end;

Обработаем это событие для обоих гридов: 

			
//--------------------------------------------------------------------------------------------------
// Так как определять ведомый грид приходится не один раз, правильно выделить это в отдельный метод
Function TfExDBG.GetSlaveGrid( MasterGrid : TexDBGrid) : TexDBGrid;
Begin
   // MasterGrid инициирует синхронизацию, он — ведущий грид
   // определяем "ведомый" грид
   IF MasterGrid.Name = 'TotalGrid'  Then Result:=MainGrid
   Else Result:=TotalGrid;
End;					  
//----------------------------------------------------------------------------------------
Procedure TfExDBG.OnSetColumnAttr(Sender: TObject);
Begin
    IF NOT SynchProccesed
    Then  SynchronizeGrids( TexDBGrid(Sender) ,GetSlaveGrid(TexDBGrid(Sender)) );
End;
//----------------------------------------------------------------------------------------

Ну а теперь, пробуйте! :о)

Для того, чтобы расслабиться перед следующим "броском", пристроим к нашему гриду несколько простых, но приятных бантиков :о)

Вызываем разные меню для заголовков и области данных

[ К содержанию ]

В момент нажатия правой кнопки мыши нам доступны ее координаты относительно самого грида (так называемые клиентские координаты). Для того, чтобы понять, в какой области мы оказались (в области заголовка или данных), нам необходимо получить номер столбца и строки той ячейки, в которую мы попали. Для этого создадим соответствующий метод в нашем наследнике:

procedure TexDBGrid.MouseToCell(X, Y: Integer; var ACol,  ARow: Integer);
Var Coord: TGridCoord;
Begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
End;

И теперь обработаем событие OnMouseUp: 

//----------------------------------------------------------------------------------------
procedure TfExDBG.GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var   Row, Col : Integer;
      APoint   : TPoint;
      Grid     : TexDBGrid;
begin
  Grid:=TexDBGrid(Sender);

  // Получим номер строки и столбца грида, над которыми произошел клик мышкой
  Grid.MouseToCell(X,Y,Col,Row);

  IF Button = mbRight
  Then // Если мышка не попала на незаполненную область грида
       IF (Col >= 0)  AND (Row >=0 ) Then
       Begin
          // Нажатие правой кнопки мыши, проверяем какое меню требуется вызвать
          IF Row = 0 Then Grid.PopUpMenu:=pmTitle
          Else Grid.PopUpMenu:=pmData;
		  
		  // Получаем из координат мыши(относительно грида — клиентские координаты) 
		  // экранные координаты для всплывающего меню
          APoint := Grid.ClientToScreen(Point(X,Y));
          Grid.PopUpMenu.Popup(APoint.X,APoint.Y);
       End;
end;
//--------------------------------------------------------------------------------------------------

Выделение цветом текущей строки

Этим способом поделился с нами Яловенко Юрий (Симферополь).

[ К содержанию ]

При установке в опциях грида свойства dgRowSelect, текущая строка всегда выделяется полностью, но нельзя редактировать поля. Как выделить цветом строку при условии, что любое поле можно редактировать?

Основной проблемой здесь является вопрос, как понять, что строка, которая рисуется и есть текущая. Смотрим свойство TDataLink.ActiveRecord 

Specifies the index of the current record within the internal 
set of records buffer maintained by the dataset 
for the Owner of the TDataLink object.

property ActiveRecord: Integer;

Description

Use ActiveRecord to discover or set the current record in the set 
of one or more records managed by the dataset.
The set of records managed by the dataset corresponds to the number 
of records from the dataset visible at one time. 
For example, when the TDataLink object is owned by a data-aware grid, 
the set of records managed by the dataset 
corresponds to the number of rows shown by the grid, 
and the ActiveRecord represents the current row.

Очень полезное свойство. 

								
    Property ActiveRecord : Integer read GetActiveRecord;
...							

function TexDBGrid.GetActiveRecord: Integer;
begin
  Result:=DataLink.ActiveRecord;
end;

И внесем необходимые изменения в обработку рисования строк грида: 

//--------------------------------------------------------------------------------------------------
procedure TfExDBG.mainGridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
   // Выделяем текущую строку
   IF  TexDBGrid(Sender).ActiveRecord = TexDBGrid(Sender).Row-1 Then
         TDBGrid(Sender).Canvas.Brush.Color:=RGB($CC,$CC,$99);

   IF  (gdSelected IN State)
   Then Begin
   		TDBGrid(Sender).Canvas.Brush.Color:= clHighLight;
   		TDBGrid(Sender).Canvas.Font.Color := clHighLightText;
   	End;
   // А теперь пусть он рисует сам !
   TDBGrid(Sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
//--------------------------------------------------------------------------------------------------

А вот еще один способ выделять строку как в RowSelect (из Demo к TDBGridEh Дмитрия Большакова): 

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  Grid : THSDBGrid;
begin
  Grid := THSDBGrid(Sender);
  if (Rect.Top = Grid.CellRect(Grid.Col, Grid.Row).Top) and
    //В данном случае проверяется, что мы рисуем текущую строку
     (not (gdFocused in State) or not Grid.Focused) then
    //И фокус находится не на текущем столбце или фокус вообще не на гриде	 
    Grid.Canvas.Brush.Color := TColor($D86A10);
  Grid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

Для этого надо в нашем наследнике объявить в секцию public процедуру CellRect, как 
    function CellRect(ACol, ARow: Longint): TRect;
а ее реализацию выполнить: 
function TexDBGrid.CellRect(ACol, ARow: Integer): TRect;
begin
  Result := inherited CellRect (ACol, ARow);
end;


Сложные заголовки

А теперь снова вернемся к заголовкам и пойдем по дорожке, только что проложенной в самом начале статьи. Если мы умеем рисовать в заголовках, то мы можем очень многое, практически все :о)
На рис.2 изображен грид со сложными заголовками. Разберем один из возможных способов достижения такого результата.

Сложные заголовки

[ К содержанию ]
Изначально наш грид выглядит вот так:



Для того, чтобы добавить объединяющие заголовки для существующих, совершенно явно следует увеличить по высоте область заголовков грида.



И в нужном месте дорисовать самим объединяющую часть заголовка.



Реализация описанной методики в нашем наследнике TexDBGrid:
  1. Введем свойство, которое будет включать/выключать режим сложных заголовков. 

      TexDBGrid = class(TDBGrid)
  private
    FSubHeader  : Boolean;  // подзаголовки
  ...
  published
    Property SubHeader : Boolean read FSubHeader  write SetSubHeader;

    Именно это свойство будет регулировать высоту области заголовков. 

    								
...
Const
  TITLE_SUBHEADER = 2;
  TITLE_DEFAULT   = 1;
...   						
//*******************************************************
procedure TexDBGrid.CalcTitle;
begin
    RowHeights[0] := 19 * FTitleLines ;
end;
//*******************************************************
procedure TexDBGrid.SetSubHeader(const Value: Boolean);
begin
  FSubHeader := Value;

  IF FSubHeader Then FTitleLines:=TITLE_SUBHEADER
  Else FTitleLines:=TITLE_DEFAULT;
  CalcTitle;
end;

  2. В метод TexDBGrid.DrawCell добавляем обработку 

        IF FSubHeader Then
    Begin
      // Рисуем объединяющий заголовок Header к мелким заголовкам Title
      DrawSubHeader(DataCol, Canvas);

      // Рисуем заголовки Title
      FRect:=ARect;
      FRect.Top:=RectHeight(ARect) div FTitleLines;

      DrawTitleCell(FRect,Columns[DataCol]);
    End
    Else  DrawTitleCell(FRect,Columns[DataCol]);

    Здесь рисование заголовка разбито на две процедуры: DrawSubHeader и DrawTitleCell. Где DrawTitleCell рисует в прямоугольнике 3D-окантовку, заливает его цветом FixedCols и вписывает текст. То есть имитирует обычный заголовок колонки. А вот на процедуре DrawSubHeader остановимся поподробнее.

  3. Для того, чтобы нарисовать объединяющий заголовок для нескольких колонок, нужно получить прямоугольник (TRect), который объединяет эти колонки и текст, который следует писать в объединяющем заголовке. Для обеспечения гибкой настройки создадим два свойства: 

      published
    Property OnGetHeaderText    : TOnGetHeaderText read FOnGetHeaderText  write FOnGetHeaderText;
    Property OnGetHeaderRect    : TOnGetHeaderRect read FOnGetHeaderRect  write FOnGetHeaderRect;

    С помощью этих свойств можно будет настраивать обработчики соответствующих событий. 

      Procedure DrawSubHeader(ACol : Integer; Canvas : TCanvas);
  Var HRect : TRect;
  Begin				   
    // Получаем прямоугольник, объединяющий несколько колонок,
    // для которых рисуем сложный заголовок
    HRect:=GetHeaderRect(ACol);
    // По высоте берем только часть прямоугольника 
    // так как вторая часть — обычный заголовок
    HRect.Bottom:=RectHeight(HRect) div TITLE_SUBHEADER;
    Canvas.FillRect(HRect);

    // Вписываем текст,
    // который получаем методом GetHeaderText
    InflateRect(HRect,-1,-1);
    WriteText(Canvas, HRect, GetHeaderText(ACol) , taCenter);
	
    // Рисуем 3D-окантовку 
    Paint3dRect(Canvas.Handle,HRect);
  End;

    Внутри методов GetHeaderRect и GetHeaderText будут вызываться обработчики событий FOnGetHeaderRect и FOnGetHeaderText.

    При этом, следует помнить, что в каждый момент могут быть видны не все колонки из объединенных в блок. Воспользуемся функцией TCustomDBGrid.CalcTitleRec, которая возвращает прямоугольник для определенной колонки и строки. Если в данный момент эта колонка не видна, то будет возвращен нулевой прямоугольник. 

    Function TexDBGrid.GetHeaderRect(ACol : Integer) : TRect;
Var MasterCol   : TColumn;
    Index,Shift ,
    Count,i     : Integer;
Begin		   
  // Если в опциях отключен показ сетки, это нужно учесть при расчете 
  // общего прямоугольника
  IF [dgColLines] * Options = [dgColLines] Then Shift:=1
  Else Shift:=0;

  Index:=ACol;
  Count:=1;				
  // получаем информацию для текущей колонки грида:
  // в какой объединяющий блок она входит 
  // Index — с какой колонки начинается объединяющий блок
  // Count — сколько колонок он включает
  IF Assigned(FOnGetHeaderRect) Then FOnGetHeaderRect(ACol, Index, Count);

  IF Index+Count-1 > Columns.Count-1 Then
  Begin
    Index:=ACol;
    Count:=1;
  End;
  
  // В результате нужно получить прямоугольник, состоящий из
  // всех, включенных в объединенный блок колонок
  Result:=CalcTitleRect(Columns[Index],0,MasterCol);

  For i:=Index+1 To Index + Count -1 Do
  Result.Right:=Result.Right + RectWidth(CalcTitleRect(Columns[i] ,0,MasterCol)) + Shift;

End;

И для примера покажем, как именно могут использоваться обработчики событий получения объединяющего прямоугольника и текста при использовании сложных заголовков: 

Const
   GeoColumns   = 3;
   ParamColumns = 2;
...   
//----------------------------------------------------------------------------------------
// Получить для текущей колонки информацию о том, в какое объеденение колонок она попадает
//----------------------------------------------------------------------------------------
procedure TfExDBG.GetHeaderRect(ACol: Integer; var IndexStart,  Count: Integer);
begin
  IF ACol < GeoColumns
  Then Begin
         IndexStart:=0;
         Count:=GeoColumns;
       End
  Else Begin
         IndexStart:=GeoColumns;
         Count:=ParamColumns;
       End
end;
//----------------------------------------------------------------------------------------
// Получить для текущей колонки текст заголовка объеденени
//----------------------------------------------------------------------------------------
procedure TfExDBG.GetHeaderText(ACol: Integer; var Text: String);
begin
  IF ACol < GeoColumns Then Text:='География'
  Else Text:='Параметры';
end;
//----------------------------------------------------------------------------------------

Предложенный способ просто один из возможных, он не позволяет настраивать параметры объединяющих заголовков в design-time, рассчитан на использование двухуровневых заголовков и предполагает наличие сложных заголовков у всех колонок грида.

Например, для того, чтобы сделать так, как показано на рисунке ниже, следует свойство SubHeader привязывать не ко всему гриду, а к каждой его колонке.

Рассказать о реализации всех вариантов сложных заголовков не представляется возможным. Изучив наши примеры, Вы можете сами совершенствовать новый грид, по собственному усмотрению.

Запрет перемещения колонок с разрешением менять их ширину

[ К содержанию ]

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

В опциях грида объединены запрет/разрешение на передвижение колонок и на изменение их ширины (dbColumnResize). Если запретить перемещать колонки, тогда нельзя будет менять их ширину. В нашем случае это неудачное сочетание будет крайне неудобно с точки зрения пользователя.

Введем еще одно поле, которое будет отдельно запрещать перемещение колонок: 

  TexDBGrid = class(TDBGrid)
  private
    ...
    FAllowColumnMoved: Boolean;
	...
  public	
    Property AllowColumnMoved   : Boolean  read FAllowColumnMoved write SetAllowColumnMoved;

Изучив исходные коды DBGrids.pas, обратим внимание на метод BeginColumnDrag (см. help). Этот метод вызывается тогда, когда начинается перетаскивание колонок.

Переопределим его в нашем наследнике: 

function TexDBGrid.BeginColumnDrag(var Origin, Destination: Integer; const MousePt: TPoint): Boolean;
Begin
  Result:=FAllowColumnMoved;
  
  // Разрешить передвигать колонки только если это разрешено в настройках: AllowColumnMoved
  IF Result Then Result:= Inherited BeginColumnDrag(Origin,Destination,MousePt);    
End;

Так как мы контролируем непосредственно начало процесса перемещения, то возможность менять ширину колонок остается у пользователя.

Имитация внутренних группировок и метки колонок

Работая с заголовками мы не один раз их перерисовывали, вписывая текст и добавляя 3D-окантовку. Это умение можно использовать в любом месте сетки грида, а не только в заголовках

Рисуем ячейку в стиле заголовка в любом месте TDBGrid

[ К содержанию ]


Добавим нашему гриду еще один метод — DrawCellButton, который будет рисовать в любой ячейке 3D-окантовку, то есть делать имитацию заголовка. Передавать в нее будем прямоугольник этой ячейки, текст, выравнивание текста, шрифт, которым текст будет выведен и состояние (State) грида. Состояние нам понадобится для нормальной работы с фиксированными колонками.

procedure TexDBGrid.DrawCellButton(Rect: TRect; Text: String;
  Style: TFontStyles; State: TGridDrawState; Alignment: TAlignment);
Var Shift : Integer;
begin
  //Очищаем ячейку
  Canvas.Brush.Color:=clBtnFace;
  Canvas.Font.Color:=clBtnText;
  Canvas.Font.Style:=Style;
  Canvas.FillRect(Rect);

  // Если ячейка фиксирована, то мы получим TRect меньшего размера,
  // чем для обычной ячейки. Это нужно учесть   
  Shift:=-2 + ORD(gdFixed In State);

  // вписываем текст
  InflateRect(Rect,Shift,0);
  WriteText(Canvas, Rect, Text , Alignment );
  InflateRect(Rect,(-1)*Shift,0);

  // рисуем по размеру ячейки button
  // только если это не фиксированная ячейка, так как для нее окантовка уже нарисована 
  IF NOT (gdFixed in State) Then
  Begin
    // Рисуем аналог разделительных линий между фиксированными ячейками грида
    // (они рисуются черным цветом, в отличие от серых линий между ячейками
    // данных (grids.pas))
    InflateRect(Rect, 1, 1);
    Rect.Top:=Rect.Top + 1;
    FrameRect(Canvas.Handle, Rect, GetStockObject(BLACK_BRUSH));

    Rect.Top:=Rect.Top - 1;
    // Закончили имитацию линий между фиксированными ячейками.
    InflateRect(Rect, -2, -2);
    Paint3dRect(Canvas.Handle, Rect);
  End;

end;

Такой, на первый взгляд экзотический, вариант ячейки поможет нам создать видимость внутренних группировок в гриде (рис. 4).


рис. 4

Имитация внутренних группировок

[ К содержанию ]

Для создания внутренних группировок необходимо подготовить не только TDBGrid, но и набор данных, которые он будет отображать. Ведь TDBGrid не умеет показывать строк, которых нет в его источнике данных (TDataSource).

Подготовим данные по такому запросу: выберем всю информацию по странам и добавим список континентов с суммами полей "население" и "площадь". Обычный UNION-запрос: 

Select 1 as TypeRecord , Continent , Name,  Area ,  Population
From country
Union 
Select 0 as TypeRecord,Continent ,Continent as Name,  Sum(Area) as Area , Sum(Population) as Population
From country
Group By Continent
Order by 2,1

Итак, мы получим для каждого континента список его стран и еще одну запись, которую мы будем использовать как служебную запись для группировки, суммы по континенту эта строка уже содержит. Идентифицировать служебную запись можно по значению служебного поля TypeRecord (именно для этого оно и введено).

Добавим в обработку события OnDrawColumnCell рисование группировочной строки: 

procedure TfExDBG.__GridFixDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;  State: TGridDrawState);
Var Alignment : TAlignment;
begin
  // рисуем на строке итогов имитацию заголовка грида
  IF Column.Field.DataSet.FieldByName('TypeRecord').AsInteger = 0
  Then TexDBGrid(Sender).DrawCellButton(Rect,Column.Field.DisplayText,[fsBold],State,Alignment)
end;

Вуаля! :о)

А вот еще один вариант группировок — без итогов по каждой колонке, только отделение групп данных друг от друга (рис. 5).


рис. 5

Для его реализации добавим метод, аналогичный DrawCellButton, вернее создадим новый на его основе. Метод DrawRowButton делает тоже самое, что и DrawCellButton, но только всегда растягивает картинку на всю видимую строку грида.

procedure TexDBGrid.DrawRowButton(Rect: TRect; Text: String; Style: TFontStyles; Alignment: TAlignment);
Var FullRect : TRect;
    Col      : TColumn;
begin
    FullRect:=Rect;
    FullRect.Left:=IndicatorWidth + 1;
    FullRect.Right:=CalcTitleRect(Columns[Columns.Count-1],0,Col).Right;

    DrawCellButton(FullRect,Text,Style,[],Alignment);
end;

Метки колонок: рисуем в заголовке TCheckBox или TRadioButton

[ К содержанию ]
Вновь вернемся к заголовкам. Допустим нам надо реализовать возможность как-то отметить колонку. В принципе для таких целей может служить два контрола TCheckBox и TRadioButton. Для рисования в заголовках воспользуемся специальным событием нашего нового грида: OnDrawTitleRect 

procedure TfExDBG.OnDrawTitleRect(Sender: TObject; ACol: Integer; Column: TColumn; ARect: TRect);
Var Style, TypeButton : Word;
    FRect : TRect;
begin
  IF ACol >= TexDBGrid(Sender).FixedCols Then
  Begin
    InflateRect(ARect, -1, -1);

    TDBGrid(Sender).Canvas.FillRect(ARect);
						 
    // Ширина прямоугольника для рисования контрола - 20 пикселей
    FRect:=ARect;
    IF RectWidth(FRect) > 20 Then FRect.Right:=FRect.Left + 20;

    // Определяем отмечено или нет текущее поле
    IF Column.Field.Tag = 1
    Then Style:=DFCS_CHECKED
    Else Style:=0;

    // Выбираем тип контрола для отметки колонки
    IF FTitleIsCheckBox
    Then TypeButton:=DFCS_BUTTONCHECK
    Else TypeButton:=DFCS_BUTTONRADIO;

    // Рисуем отметку
    DrawFrameControl(TDBGrid(Sender).Canvas.Handle, FRect, DFC_BUTTON,  TypeButton OR Style);

    FRect.Left:=FRect.Right + 1;
    FRect.Right:=ARect.Right;

    // Текст заголовка
    WriteText(TDBGrid(Sender).Canvas,FRect,Column.Title.Caption,Column.Title.Alignment);
  End;
end;

Обработку нажатия на метку колонки проводим в обработчике события OnMouseUp. В приведенном примере для хранения отметки столбца используется свойство TField.Tag. Естественно, это только один из возможных вариантов.

procedure TfExDBG.GridFixMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Const MinX = 2;
      MaxX = 20;
Var Row, Col ,
    i        : Integer;
    Grid     : TexDBGrid;
Begin
  Grid:=TexDBGrid(Sender);

  // Получим номер строки и столбца грида, над которыми произошел клик мышкой
  Grid.MouseToCell(X,Y,Col,Row);

  IF Button = mbLeft
  Then Begin
          // Левая кнопка мыши — проверяем попадание в заголовок
          // и обязательное попадание на сам крыжик
          IF (Row = 0) AND (Col > Grid.FixedCols ) AND
             (Grid.Columns[Col - 1].Field <> nil)
          Then Begin
		 Dec(X, Grid.TitleRect(Col-1).Left);

		// Проверяем попадание в область крыжика
		 IF (X > MinX) and (X < MaxX) Then
		 Begin
                   Tag:=Grid.Columns[Col - 1].Field.Tag;

                   // Снимаем отметку со всех колонок (если это TRadioButton)
                   IF NOT FTitleIsCheckBox
                   Then For i:=0 To Grid.Columns.Count - 1 Do Grid.Columns[i].Field.Tag:=0;

                   // И отмечаем текущую
                   Grid.Columns[Col - 1].Field.Tag:=1 - Tag;
				   
                   // Перерисовываем только заголовки, а не весь грид
                   Grid.RefreshTitles;
                   RefreshSelect;
		 End;
               End;
       End;
End;

Использование фиксированных колонок

[ К содержанию ]

И последнее, что мы сотворим с нашим гридом :о), это снабдим его свойством FixedCols, которого так не хватает в стандартном TDBGrid'е.

Для тех, кто может быть не знает, отметим, что у стандартного TDBGrid есть фиксированный столбец, он используется гридом для внутренних нужд. Это тот самый индикатор слева, в котором рисуется треугольник, указывая на текущую строку. Добавляя свое свойство FixedCols, необходимо это учитывать.

  TexDBGrid = class(TDBGrid)
  private
  ...
    FFixedCols       : Integer;
  ...
  public
    Property FixedCols : Integer  read GetFixedCols write SetFixedCols;
  ...

//**************************************************************************************************
procedure TexDBGrid.SetFixedCols(const Value: Integer);
Var FixedCount,i : Integer;
begin

  // Следует учесть индикатор грида
  IF Value <= 0 Then FixedCount:=IndicatorOffset
  Else FixedCount := Value + IndicatorOffset;

  IF DataLink.Active AND NOT (csDesigning in ComponentState) AND (ColCount > IndicatorOffset + 1) Then
  Begin
    IF FixedCount >= ColCount Then FixedCount:=ColCount - 1;

    Inherited FixedCols := FixedCount;

    // На фиксированных колонках нельзя останавливаться по табуляции
    For i := 1 To FixedCols  Do
    TabStops[I] := False;
  End;

  FFixedCols := FixedCount - IndicatorOffset;
end;
//**************************************************************************************************
function TexDBGrid.GetFixedCols: Integer;
begin
  IF DataLink.Active Then Result := Inherited FixedCols - IndicatorOffset
  Else Result := FFixedCols;
end;
//**************************************************************************************************

Необходимо восстанавливать данные о фиксированных колонках каждый раз, когда параметры колонок будут пересчитываться. Смотрите в иллюстрирующем проекте процедуры TexDBGrid.LayoutChanged; и TexDBGrid.SetColumnAttributes.

Для того, чтобы в нашем гриде фиксированные колонки вели себя также, как ведут они себя, например, в TStringGrid, нужно обработать реакцию на мышь и клавиатуру.

//**************************************************************************************************
Procedure TexDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
Var  KeyDownEvent: TKeyEvent;
Begin		 
  KeyDownEvent := OnKeyDown;
  IF Assigned(KeyDownEvent) Then KeyDownEvent(Self, Key, Shift);

  IF NOT Datalink.Active OR NOT CanGridAcceptKey(Key, Shift) Then Exit;
  
  // наша задача - не пустить в область фиксированных колонок,
  // то есть SelectedIndex  не может быть меньше, чем FFixedCols 
  IF ssCtrl IN Shift Then
  Begin
    IF (Key = VK_LEFT) AND (FixedCols > 0) Then
    Begin
      SelectedIndex := FixedCols;
      Exit;
    End;
  End
  Else Case Key Of
        VK_LEFT: IF (FixedCols > 0) AND NOT (dgRowSelect in Options)
                 Then IF SelectedIndex <= FFixedCols Then Exit;

        VK_HOME: IF (FixedCols > 0) AND (ColCount <> IndicatorOffset + 1)
                    AND NOT (dgRowSelect IN Options) Then
                  Begin
                    SelectedIndex := FixedCols;
                    Exit;
                  End;
       End;

  OnKeyDown := Nil;
  Try
    Inherited KeyDown(Key, Shift);
  Finally
    OnKeyDown := KeyDownEvent;
  End;

end;
//**************************************************************************************************
procedure TexDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,  Y: Integer);
Var Cell : TGridCoord;
begin

  Cell:=MouseCoord(X,Y);
  
  //При скроллировании данных фиксированные колонки должны оставаться на месте
  IF (Cell.X >= 0) AND (Cell.X < FixedCols + IndicatorOffset) AND Datalink.Active Then
  Begin
      IF (dgIndicator IN Options)
      Then Inherited MouseDown(Button, Shift, 1, Y)
      Else IF (Cell.Y >= 1) AND (Cell.Y - Row <> 0)
           Then Datalink.Dataset.MoveBy(Cell.Y - Row);
  End
  Else inherited MouseDown(Button, Shift, X, Y);

end;
//**************************************************************************************************

Вот, собственно и все, что мы хотели рассказать.

[ К содержанию ]

Елена Филиппова и Игорь Шевченко
Специально для Королевства Delphi





К материалу прилагаются файлы: