2003 г
НеОбычный TDBGrid
Игорь Шевченко, Елена Филиппова,
Королевство Дельфи
10 июня 2003г.
Содержание
- Многострочные заголовки
- Компонент в ячейке редактирования
- Подмена стандартного Inplace-Editor'a в DBGrid отдельным компонентом на примере TDBComboBox.
- Синхронизация гридов
- Сложные заголовки
- Имитация внутренних группировок и метки колонок
Материал рассчитан на начинающих программистов, которые хотят научиться
не только использовать чужие компоненты, но и писать свои. Авторы ни в коем случае не отрицают
положительные стороны использования сторонних компонентов, более того, нередко сами их используют. Тем не менее, придерживаются
четкого мнения, что если хочешь контролировать ситуацию — нужно знать "как оно там все работает".
Обычный 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
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);
SetRect(ARect, Rect.Left, 0, Rect.Right, RH);
InflateRect(ARect, -2, -2);
Dec(RH, 2);
with DBGrid1.Canvas do begin
Brush.Color := DBGrid1.FixedColor;
FillRect(ARect);
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;
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();
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 = ' ';
var
CurPos, J: Integer;
CurStr: string;
begin
SetLength(Titles, FTitleLines);
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
if csLoading in ComponentState then begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
DataCol := ACol;
if dgIndicator in Options then
Dec(DataCol);
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(ARect, -1, -1);
TitleText := Columns[DataCol].Title.Caption;
Canvas.Brush.Color := FixedColor;
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;
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'а
появился другой компонент, проделаем несколько действий:
- Создадим отдельный компонент, который будет редактором (в примере используется TDBComboBox).
При его создании следует установить свойство Visible в False, для того, чтобы вне грида он не отображался.
Компонент DBComboBox выбран для того, чтобы обеспечить автоматическую связь с данными в DataSet'е, который отображается в Grid'е.
При создании компонента, свяжем его с тем же набором данных, что и
Grid, в качестве DataField установим имя того поля, редактор которого
в гриде мы хотим подменять. Вместо создания вручную компонент можно положить на форму
в design-time
FEditor := TDBComboBox.Create(Self);
FEditor.Parent := Self;
FEditor.Visible := false;
FEditor.Style := csDropdownList;
FEditor.DataSource := DBGrid.DataSource;
FEditor.DataField := 'STATE'; | |
В данном примере список ComboBox'а заполняется значениями из Picklist
нужного столбца грида.
for I:=0 to Pred(DBGrid.Columns.Count) do
if DBGrid.Columns[I].Field.FieldName = FEditor.DataField then begin
FEditor.Items.Assign(DBGrid.Columns[I].PickList);
Break;
end; | |
- Показывать этот компонент мы будем в обработчике события OnDrawColumnCell, когда нужная колонка получает фокус (рис. 2).
рис. 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
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
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
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
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
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
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:
- Введем свойство, которое будет включать/выключать режим сложных заголовков.
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; | |
- В метод TexDBGrid.DrawCell добавляем обработку
IF FSubHeader Then
Begin
DrawSubHeader(DataCol, Canvas);
FRect:=ARect;
FRect.Top:=RectHeight(ARect) div FTitleLines;
DrawTitleCell(FRect,Columns[DataCol]);
End
Else DrawTitleCell(FRect,Columns[DataCol]); | |
Здесь рисование заголовка разбито на две процедуры: DrawSubHeader и DrawTitleCell.
Где DrawTitleCell рисует в прямоугольнике 3D-окантовку, заливает его цветом FixedCols и вписывает
текст. То есть имитирует обычный заголовок колонки. А вот на процедуре DrawSubHeader остановимся поподробнее.
- Для того, чтобы нарисовать объединяющий заголовок для нескольких колонок, нужно получить
прямоугольник (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);
InflateRect(HRect,-1,-1);
WriteText(Canvas, HRect, GetHeaderText(ACol) , taCenter);
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;
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;
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);
Shift:=-2 + ORD(gdFixed In State);
InflateRect(Rect,Shift,0);
WriteText(Canvas, Rect, Text , Alignment );
InflateRect(Rect,(-1)*Shift,0);
IF NOT (gdFixed in State) Then
Begin
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);
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;
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;
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
Скачать проект: ExDBGrid.zip (25К)
🔥 VPS до 5.7 ГГц под любые задачи с AntiDDoS в 7 локациях
Виртуальные VPS серверы в РФ и ЕС
